Generated: Sun Aug 21 11:11:00 2011 from findfunc.pl 2010/11/02 21.4 KB.
#!/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