#!/usr/bin/perl -w
# NAME: findfunc.pl
# AIM: Search C/C++ files to find a function...
# 21/10/2010 geoff mclane http://geoffair.net/mperl
use strict;
use warnings;
use File::Basename;  # split path ($name,$dir,$ext) = fileparse($file [, qr/\.[^.]*/] )
use File::Spec; # File::Spec->rel2abs($rel); # we are IN the SLN directory, get ABSOLUTE from RELATIVE
use Cwd;
my $perl_dir = 'C:\GTools\perl';
unshift(@INC, $perl_dir);
require 'lib_utils.pl' or die "Unable to load 'lib_utils.pl'! Check location and \@INC content.\n";
# log file stuff
my ($LF);
my $pgmname = $0;
if ($pgmname =~ /(\\|\/)/) {
    my @tmpsp = split(/(\\|\/)/,$pgmname);
    $pgmname = $tmpsp[-1];
}
my $outfile = $perl_dir."\\temp.$pgmname.txt";
open_log($outfile);

# user variables
my $load_log = 0;
my $in_file = '';
my $in_find = '';
my $verbose = 0;
my $recursive = 0;
my $show_static_items = 0;
my $max_inc_name = 30;
my $show_includes = 0;
my $find_all = 0;   # not ONLY in functions
my @hash_items = qw(define error pragma include if ifdef ifndef else endif elif undef warning line import);

my $debug_on = 0;
my $def_file = 'C:\Projects\glib-2.24.2\glib';
#my $def_file = 'C:\Projects\glib-2.24.2\glib\gmessages.h';
#my $def_file = 'C:\Projects\glib-2.24.2\glib\gconvert.c';
#my $def_file = 'C:\GTools\perl\temp.cpp';
#my $def_file = 'C:\Projects\glib-2.24.2\glib\gmarkup.c';
#my $def_file = 'C:\Projects\glib-2.24.2\glib\gmessages.c';
my $def_find = '';
#my $def_find = 'g_print';

my $dbg_ff01 = 0;
my $dbg_ff02 = 0;
my $dbg_ff03 = 0;
my $dbg_ff04 = 0;
my $dbg_ff05 = 0;
my $dbg_ff06 = 0;
my $dbg_ff07 = 0;

sub set_debug_value($) {
    my ($v) = @_;
    $dbg_ff01 = $v; $dbg_ff02 = $v; $dbg_ff03 = $v; $dbg_ff04 = $v; $dbg_ff05 = $v; $dbg_ff06 = $v;
    $dbg_ff07 = $v;
}

sub set_debug_on() { set_debug_value(1); }
sub set_debug_off() { set_debug_value(1); }

### set_debug_on();

### program variables
my @warnings = ();
my $cwd = cwd();
my $os = $^O;
my %all_includes = ();
my $root_dir = '';
my $total_files = 0;
my $total_sources = 0;
my $total_dirs = 0;
my $total_lines = 0;

sub VERB1() { return ($verbose >= 1); }
sub VERB2() { return ($verbose >= 2); }
sub VERB5() { return ($verbose >= 5); }
sub VERB9() { return ($verbose >= 9); }

sub show_warnings($) {
    my ($val) = @_;
    if (@warnings) {
        prt( "\nGot ".scalar @warnings." WARNINGS...\n" );
        foreach my $itm (@warnings) {
           prt("$itm\n");
        }
        prt("\n");
    } else {
        #prt( "\nNo warnings issued.\n\n" );
    }
}

sub pgm_exit($$) {
    my ($val,$msg) = @_;
    if (length($msg)) {
        $msg .= "\n" if (!($msg =~ /\n$/));
        prt($msg);
    }
    show_warnings($val);
    close_log($outfile,$load_log);
    exit($val);
}


sub prtw($) {
   my ($tx) = shift;
   $tx =~ s/\n$//;
   prt("$tx\n");
   push(@warnings,$tx);
}

sub ff_get_root_dir() { return $root_dir; }

sub ff_begins_with {
    my ($rt, $pt) = @_;
    my $ln = length($rt);
    my ($i);
    if (length($pt) >= $ln) {
        for ($i = 0; $i < $ln; $i++) {
            return 0 if (substr($rt,$i,1) ne substr($pt,$i,1));
        }
        return 1; # does indeed begin with...
    }
    return 0;
}

# VARIOUS FIXES FOR THE FILE NAME
# 1. ensure ALL DOS format
# 2. remove any simple dot relative, like '.\' from beginning
sub ff_sub_root_dir($) {
    my ($ff) = shift;   # = $a_dir.$src
    $ff = path_u2d($ff);
    $ff = substr($ff,2) if ($ff =~ /^\.\\/);
    my $rd = path_u2d(ff_get_root_dir());
    $rd .= "\\" if ( !($rd =~ /(\\|\/)$/) );
    if (ff_begins_with($rd, $ff)) {
        $ff = substr($ff, length($rd));
    }
    return $ff;
}

sub ff_get_nxt_sig_char($$$$$$) {
    my ($line,$len,$i2,$rlines,$ln,$lncnt) = @_;
    my $nsc = '';
    my ($i,$j);
    for ($i = ($i2 + 1); $i < $len; $i++) {
        $nsc = substr($line,$i,1);
        return $nsc if ($nsc =~ /\S/);
    }
    # ok, must get next line to find the next sig char
    for ($j = ($ln + 1); $j < $lncnt; $j++) {
        $line = ${$rlines}[$j];
        chomp $line;
        $len = length($line);
        for ($i = 0; $i < $len; $i++) {
            $nsc = substr($line,$i,1);
            return $nsc if ($nsc =~ /\S/);
        }
    }
    return $nsc;
}

# FIX20101102 - no dealing with say  "\\\""
sub ff_process_file_lines($$$) {
    my ($rlines,$lncnt,$fil) = @_;
    my ($line,$inc,$lnn,$incomm,$infunc,@brack,@brace,$len,$ch,$i,$ln,$i2,$nc,$pc);
    my ($inquots,$brcnt,$bkcnt,$tag,@tags,$hadeq,$showtags);
    my ($bgnln,$endln,$nsc,$msg,$tag_list,$tag_lns,$qt,$ppc,$tline,$tlen);
    my ($hitm,$fnd);
    $lnn = 0;
    $ch = '';
    $incomm = 0;
    $inquots = 0;
    @brack = ();
    @brace = ();
    $brcnt = 0;
    $bkcnt = 0;
    $tag = '';
    @tags = ();
    $hadeq = 0;
    $showtags = '';
    $bgnln = 0;
    $endln = 0;
    $nsc = '';
    $qt = '';
    $pc = '';
    my @all_tags = ();
    my @includes = ();
    my %hash = ();
    $total_lines += $lncnt;
    for ($ln = 0; $ln < $lncnt; $ln++) {
        $line = ${$rlines}[$ln];
        chomp $line;
        $lnn = $ln + 1;
        $len = length($line);
        $tline = trim_tailing($line);
        while ( ($line =~ /\\$/) && (($ln+1) < $lncnt) ) {
            $line  =~ s/\\$//;
            $tline =~ s/\\$//;
            $ln++;
            $line .= ${$rlines}[$ln];
            chomp $line;
            $tline .= trim_tailing($line);
        }
        $lnn = $ln + 1;
        $len = length($line);
        $tlen = length($tline);
        prt("[04] $lnn: [$line]$len ($tlen)\n") if ($dbg_ff04);
        if ($incomm == 0) {
            if ($line =~ /^\s*\#/) {
                $line = trim_leading($line);
                $line = substr($line,1);
                $line = trim_leading($line);
                $fnd = 0;
                foreach $hitm (@hash_items) {
                    if ($line =~ /^$hitm\s+/) {
                        $line =~ s/^$hitm\s+//;
                        $line = trim_all($line);
                        if ($hitm eq 'include') {
                            $line =~ s/\/\*.+$//;
                            $line =~ s/\/\/.+$//;
                            $line = trim_all($line);
                            push(@includes,$line);
                        }
                        prt("[07] $lnn: $hitm [$line]\n") if ($dbg_ff07);
                        $fnd = 1;
                        last;
                    } elsif ($line =~ /^$hitm$/) {
                        prt("[07] $lnn: $hitm\n") if ($dbg_ff07);
                        $fnd = 1;
                        last;
                    }
                }
                if (!$fnd) {
                    prtw("WARNING: $lnn: Uncased # line [$line]! FIX ME [$fil]\n");
                }
                next;
            }
        }
        if ($tlen == 0) {
            $tag = '';
        }
        for ($i = 0; $i < $len; $i++) {
            $i2 = $i + 1;
            $ppc = $pc;
            $pc = $ch;
            $ch = substr($line,$i,1);
            $nc = ($i2 < $len) ? substr($line,$i2,1) : "\n";
            $nsc = ($nc =~ /\s/) ? ff_get_nxt_sig_char($line,$len,$i2,$rlines,$ln,$lncnt) : $nc;
            if ($incomm) {
                if (($ch eq '/') && ($pc eq '*')) {
                    prt("[05] $lnn: Exit  *\ comment\n") if ($dbg_ff05);
                    $incomm = 0;
                }
            } else {
                if ($inquots) {
                    if ($ch eq $qt) {
                        # what about  "\\\""
                        if (($pc eq "\\")&&($ppc ne "\\")) {
                            prt("[06] $lnn:$i2: Exit  quote [$qt] ($inquots) SKIPPED DUE BACKSLASH\n") if ($dbg_ff06);
                        } else {
                            $inquots--;
                            prt("[06] $lnn:$i2: Exit  quote [$qt] ($inquots)\n") if ($dbg_ff06);
                        }
                    } elsif ($ch eq "\\") {
                        # really should SKIP the NEXT char, whatever its colour!!!
                        $ppc = $pc;
                        $pc = $ch;
                        $ch = $nc;
                        $i++;
                    }
                    next;
                }
                # not in QUOTES or COMMENT
                if ($ch =~ /\w/) {
                    if ( ($brcnt == 0) && ($bkcnt == 0) && ($hadeq == 0) ) {
                        $tag .= $ch;
                    }
                } else {
                    if (length($tag)) {
                        prt("[01] $lnn: tag [$tag]\n") if ($dbg_ff01);
                        if (@tags) {
                            $endln = $lnn;
                        } else {
                            $bgnln = $lnn;
                        }
                        push(@tags,$tag);
                    }
                    $tag = '';
                }

                if ($ch eq '/') {
                    if ($nc eq '*') {
                        $incomm = 1;
                        prt("[05] $lnn: Enter /* comment\n") if ($dbg_ff05);
                    } elsif ($nc eq '/') {
                        $i = $len;
                    }
                } elsif ($ch eq '(') {
                    push(@brack,$lnn);
                    $bkcnt = scalar @brack;
                    $showtags .= $ch;
                } elsif ($ch eq ')') {
                    if (@brack) {
                        pop @brack;
                    }
                    $bkcnt = scalar @brack;
                    $showtags .= $ch if (length($showtags));
                    $endln = $lnn if (@tags);
                } elsif ($ch eq '{') {
                    push(@brace,$lnn);
                    $brcnt = scalar @brace;
                    $showtags .= $ch;
                    prt("[03] $lnn: Open brace { [$brcnt]\n") if ($dbg_ff03);
                } elsif ($ch eq '}') {
                    $brcnt = scalar @brace;
                    if (@brace) {
                        pop @brace;
                        prt("[03] $lnn: Close brace } [$brcnt]\n") if ($dbg_ff03);
                    } else {
                        prt("[03] $lnn: Close brace } [$brcnt], but NONE TO CLOSE!\n") if ($dbg_ff03);
                    }
                    $brcnt = scalar @brace;
                    $showtags .= $ch if (length($showtags));
                    $endln = $lnn if (@tags);
                } elsif (($ch eq '"')||($ch eq "'")) {
                    $inquots++;
                    $qt = $ch;
                    prt("[06] $lnn:$i2: Begin quote [$qt] ($inquots)\n") if ($dbg_ff06);
                } elsif ($ch eq '=') {
                    $hadeq++;
                    $showtags .= $ch if (length($showtags) == 0);
                } elsif ($ch eq ';') {
                    $hadeq = 0;
                    $showtags .= $ch if (length($showtags) == 0);
                }

                if (length($showtags) && ($brcnt == 0) && ($bkcnt == 0) && ($nsc ne '{') && ($nsc ne '(') ) {
                    if (@tags) {
                        $tag_list = join(' ',@tags);
                        $tag_lns = sprintf("%5d:%5d:",$bgnln,$endln);
                        if ($showtags =~ /^\(\)\{(.*)\}$/) {
                            $msg = "function";
                        } elsif (($showtags =~ /^\{(.*)\}$/)&&($tag_list =~ /struct/)) {
                            $msg = 'struct  ';
                        } elsif ($showtags =~ /^=/) {
                            $msg = 'equate  ';
                        } elsif ($showtags =~ /^;/) {
                            if ($tag_list =~ /typedef/) {
                                $msg = 'typedef ';
                            } else {
                                $msg = 'declared';
                            }
                        } elsif ($showtags =~ /^\(.*\)$/) {
                            $msg = 'prototyp';
                        } elsif ($showtags =~ /^\(.*\);$/) {
                            $msg = 'prototyp';
                        } else {
                            $msg = "UNKNOWN ";
                        }
                        prt("[02] $tag_lns: $msg [$tag_list] $showtags\n") if ($dbg_ff02);
                        push(@all_tags,[$bgnln,$endln,$msg,$tag_list,$showtags]);
                    }
                    @tags = ();
                    $showtags = '';
                }
            }
        } # for line length
        if (length($tag)) {
            prt("[01] $lnn: tag [$tag] at eol\n") if ($dbg_ff01);
            if (@tags) {
                $endln = $lnn;
            } else {
                $bgnln = $lnn;
            }
            push(@tags,$tag);
        }
        $tag = '';
    } # for lines in file
    if (@brace) {
        $tag = join(' ',@brace);
        prtw("WARNING: Unclosed braces ($brcnt) $tag [$fil]\n");
    }
    if (@brack) {
        $tag = join(' ',@brack);
        prtw("WARNING: Unclosed brackets ($bkcnt) $tag [$fil]\n");
    }
    #return \@all_tags;
    $hash{'LINES'} = $rlines;
    $hash{'TAGS'} = \@all_tags;
    $hash{'FILE'} = $fil;
    $hash{'INCS'} = \@includes;
    return \%hash;
}


sub ff_process_in_file($) {
    my ($inf) = @_;
    if (! open INF, "<$inf") {
        pgm_exit(1,"ERROR: Unable to open file [$inf]\n"); 
    }
    my @lines = <INF>;
    close INF;
    my $lncnt = scalar @lines;
    prt("[v5] Processing $lncnt lines, from [$inf]...\n") if (VERB5());
    return ff_process_file_lines(\@lines,$lncnt,$inf);
}

# look for say 'DllMain', main, or WinMain... etc
sub ff_show_find($$) {
    my ($rh,$func) = @_;
    my $ra = ${$rh}{'TAGS'};
    my $fil = ${$rh}{'FILE'};
    my ($i,$max,$tl,$typ,$bln,$eln,$tls,$stg,$tag_lns,$show,$showcnt,$ex_static,$fun_cnt);
    my ($msg,$file_shown);
    $max = scalar @{$ra};
    prt("[v2] Searching in $max items extracted from [$fil] for [$func]...\n") if (VERB2());
    $showcnt = 0;
    $ex_static = 0;
    $fun_cnt = 0;
    $file_shown = 0;
    for ($i = 0; $i < $max; $i++) {
        $bln = ${$ra}[$i][0];
        $eln = ${$ra}[$i][1];
        $typ = ${$ra}[$i][2];
        $tls = ${$ra}[$i][3];
        $stg = ${$ra}[$i][4];
        $show = 0;
        if ($typ =~ /function/) {
            $fun_cnt++;
            if (length($func)) {
                if ($tls =~ /\b$func\b/) {
                    $show = 1;
                }
            } else {
                $show = 1;
            }
        } elsif ($find_all) {
            if (length($func)) {
                if ($tls =~ /\b$func\b/) {
                    $show = 1;
                }
            } else {
                $show = 1;
            }
        }
        if ($show) {
            if (!$show_static_items) {
                if ($tls =~ /^static\s+/) {
                    $ex_static++;
                    $show = 0;
                }
            }
        }
        if ($show) {
            $showcnt++;
            $tag_lns = sprintf("%3d:%5d:%5d:",$showcnt,$bln,$eln);
            if (!$file_shown) {
                prt("File: [$fil]\n");
                $file_shown = 1;
            }
            prt("$tag_lns: $typ [$tls]");
            prt(" $stg") if (VERB1());
            prt("\n");
        }
    }
    $msg = "Of $max items, $fun_cnt functions, shown $showcnt...";
    $msg .= ", $ex_static 'static' excluded." if ($ex_static);
    prt("[v5] $msg\n") if (VERB5());
    $ra = ${$rh}{'INCS'};
    $max = scalar @{$ra};
    if ($max) {
        $msg = "Has $max includes [";
        foreach $stg (@{$ra}) {
            $msg .= "$stg ";
            if (defined $all_includes{$stg}) {
                $all_includes{$stg} .= ";".ff_sub_root_dir($fil);
            } else {
                $all_includes{$stg} = ff_sub_root_dir($fil);
            }
        }
        prt("$msg]\n") if ($show_includes && VERB5());
    }
}

sub ff_process_in_dir($$);

sub ff_process_in_dir($$) {
    my ($ind,$lev) = @_;
    if (! opendir(DIR,$ind)) {
        pgm_exit(1,"ERROR: Unable to open directory [$ind]\n");
    }
    my @files = readdir(DIR);
    closedir(DIR);
    my ($file,$ff,$rh,$cnt);
    my @dirs = ();
    $ind .= "\\" if ( !($ind =~ /(\\|\/)$/) );
    $cnt = scalar @files;
    prt("[v9] Processing $cnt items, from [$ind], level $lev...\n") if (VERB9());
    foreach $file (@files) {
        next if (($file eq '.')||($file eq '..'));
        $ff = $ind.$file;
        if (-d $ff) {
            push(@dirs,$ff);
            $total_dirs++;
        } else {
            $total_files++;
            if (is_c_source($file)) {
                $total_sources++;
                $rh = ff_process_in_file($ff);
                ff_show_find($rh,$in_find);
            } elsif (is_h_source($file)) {
                $total_sources++;
                $rh = ff_process_in_file($ff);
                ff_show_find($rh,$in_find);
            }
        }
    }
    if ($recursive) {
        foreach $file (@dirs) {
            ff_process_in_dir($file,($lev + 1));
        }
    } else {
        $cnt = scalar @dirs;
        prt("Recursive OFF, so $cnt directories not processed...\n");
    }
}

sub ff_show_includes($) {
    my ($rincs) = @_;   # = \%all_includes
    my $cnt = scalar keys(%{$rincs});
    prt("Found $cnt 'includes' files...\n");
    my ($file,$len,$min,$val,@arr);
    $min = 0;
    foreach $file (keys %{$rincs}) {
        $len = length($file);
        $min = $len if ($len > $min);
    }
    $min = $max_inc_name if ($min > $max_inc_name);
    foreach $file (sort keys %{$rincs}) {
        $val = ${$rincs}{$file};
        $file .= ' ' while (length($file) < $min);
        $len = length($val);
        @arr = split(/;/,$val);
        $cnt = scalar @arr;
        prt("$file $cnt [$val]$len\n");
    }
}

#########################################
### MAIN ###

parse_args(@ARGV);

if ( -d $in_file) {
    $root_dir = $in_file;
    prt("Processing ROOT directory [$in_file]...\n");
    ff_process_in_dir($in_file,0);
} else {
    my ($tmp);
    ($tmp,$root_dir) = fileparse($in_file);
    prt("Processing file [$in_file]...\n");
    my $rh = ff_process_in_file($in_file);
    ff_show_find($rh,$in_find);
}

ff_show_includes(\%all_includes) if ($show_includes);

prt("Processed $total_dirs dirs, $total_files files, $total_sources sources, $total_lines lines...\n");
pgm_exit(0,"Normal exit(0)");
########################################
sub give_help {
    prt("$pgmname: version 0.0.1 2010-09-11\n");
    prt("Usage: $pgmname [options] in-file\n");
    prt("Options:\n");
    prt(" --help  (-h or -?) = This help, and exit 0.\n");
    prt(" --all         (-a) = Show ALL references to find item.\n");
    prt(" --find <name> (-f) = Function to find.\n");
    prt(" --includes    (-i) = Show 'include' files found.\n");
    prt(" --load-log    (-l) = Load log at end.\n");
    prt(" --recursive   (-r) = Recursive into sub-directories (if given a directory).\n");
    prt(" --show-static (-s) = Show 'static' functions.\n");
    prt(" --verbose     (-v) = Bump or set verbosity.\n");
}
sub need_arg {
    my ($arg,@av) = @_;
    pgm_exit(1,"ERROR: [$arg] must have following argument!\n") if (!@av);
}

sub parse_args {
    my (@av) = @_;
    my ($arg,$sarg);
    while (@av) {
        $arg = $av[0];
        if ($arg =~ /^-/) {
            $sarg = substr($arg,1);
            $sarg = substr($sarg,1) while ($sarg =~ /^-/);
            if (($sarg =~ /^h/i)||($sarg eq '?')) {
                give_help();
                pgm_exit(0,"Help exit(0)");
            } elsif ($sarg =~ /^a/i) {
                $find_all = 1;
            } elsif ($sarg =~ /^f/i) {
                need_arg(@av);
                shift @av;
                $sarg = $av[0];
                $in_find = $sarg;
                prt("Finding function [$in_find]\n");
            } elsif ($sarg =~ /^i/i) {
                $show_includes = 1;
            } elsif ($sarg =~ /^l/i) {
                $load_log = 1;
            } elsif ($sarg =~ /^r/i) {
                $recursive = 1;
            } elsif ($sarg =~ /^s/i) {
                $show_static_items = 1;
            } elsif ($sarg =~ /^v/i) {
                if ($sarg =~ /^v.*(\d+)$/) {
                    $verbose = $1;
                } else {
                    while ($sarg =~ /^v/i) {
                        $verbose++;
                        $sarg = substr($sarg,1);
                    }
                }
                prt("Set verbose to [$verbose].\n");
            } else {
                pgm_exit(1,"ERROR: Invalid argument [$arg]! Try -?\n");
            }
        } else {
            $in_file = File::Spec->rel2abs($arg);
            prt("Set input to [$in_file]\n");
        }
        shift @av;
    }

    if ((length($in_file) ==  0) && $debug_on) {
        $in_file = File::Spec->rel2abs($def_file);
        prt("[DBG] Set input to [$in_file]\n");
    }
    if ((length($in_find) ==  0) && $debug_on && length($def_find)) {
        $in_find = $def_find;
        prt("[DBG] Finding function [$in_find]\n");
    }
    if (length($in_file) ==  0) {
        pgm_exit(1,"ERROR: No input files found in command!\n");
    }
    if ( !(( -f $in_file) || ( -d $in_file)) ) {
        pgm_exit(1,"ERROR: Unable to find in file or directory [$in_file]! Check name, location...\n");
    }
    if (length($in_find) ==  0) {
        prt("WARNING: No input function to find found in command! Will show ALL...\n");
    }
}

# eof - findfunc.pl
