Generated: Tue Feb 2 17:54:23 2010 from chkifdef.pl 2009/09/17 8.5 KB.
#!/perl -w # NAME: chkifdef.pl # AIM: Scan a directory, and check all files for #ifdef ????, and list them... # 2009/09/17 - geoff mclane - http://geoffair.net/mperl/ use strict; use warnings; require 'logfile.pl' or die "Unable to load logfile.pl ...\n"; # log file stuff my ($LF); my $pgmname = $0; if ($pgmname =~ /\w{1}:\\.*/) { my @tmpsp = split(/\\/,$pgmname); $pgmname = $tmpsp[-1]; } my $outfile = "temp.$pgmname.txt"; open_log($outfile); my $in_dir = 'C:\Projects\hb\liboil'; my $load_log = 1; my %exclude_dirs = ( '.git' => 1 ); my %exclude_files = ( '.gitignore' => 1 ); my $total_lines = 0; my $total_files = 0; my $total_ifdef = 0; my $max_max = 30; my @files_list = (); prt( "$0 ... Processing $in_dir...\n" ); # DEBUG my $dbg01 = 0; # show my $msg = sprintf("Doing %4d items, from [$sdir]", $cnt); prt( "[dbg01] $msg... " ) if ($dbg01); my $dbg02 = 0; # prt( "[dbg02] Got $cnt files, and $dcnt folders...\n" ) if ($dbg02); my $dbg03 = 0; # $msg = sprintf( "Doing %5d lines, from [$sfn]...", $cnt ); prt( "[dbg03] $msg\n" ) if ($dbg03); my $dbg04 = 0; # simple define - if ($ival =~ /\w+/) { prt( "Line:$lnn: #if".$ityp." [$ival]\n" ) if ($dbg04); sub sub_root_name($) { my ($fil) = shift; return substr($fil,length($in_dir)); } sub process_dir($$$$) { my ($dir,$rxd,$rxf,$rfl) = @_; opendir(DIR, $dir) || mydie("Couldn't open directory [$dir]\n"); my @files = readdir(DIR); closedir(DIR); my $cnt = scalar @files; my $dcnt = 0; my @dirs = (); my $sdir = sub_root_name($dir); my $msg = sprintf("Doing %4d items, from [$sdir]", $cnt); prt( "[dbg01] $msg... " ) if ($dbg01); $dir .= "\\" if (!($dir =~ /(\\|\/)$/)); $cnt = 0; foreach my $file (@files) { next if (($file eq '.')||($file eq '..')); next if (defined ${$rxd}{$file}); next if (defined ${$rxf}{$file}); my $ff = $dir.$file; if (-d $ff) { # prt( "DIR: [$ff]\n" ); push(@dirs,$ff); $dcnt++; } else { # prt( "FIL: [$ff]\n" ); push(@{$rfl},$ff); $cnt++; } } $total_files += $cnt; prt( "[dbg02] Got $cnt files, and $dcnt folders...\n" ) if ($dbg02); foreach $dir (@dirs) { process_dir( $dir, $rxd, $rxf, $rfl ); } } sub trim_comments_from_line($) { my ($txt) = shift; my ($len,$j,$cc,$pc,$nc,$ntxt); $ntxt = ''; $len = length($txt); $cc = ''; for ($j = 0; $j < $len; $j++) { $pc = $cc; $cc = substr($txt,$j,1); $nc = (($j + 1) < $len) ? substr($txt,$j+1,1) : ''; # skip /* ... */ if (($cc eq '/')&&($nc eq '*')) { # begin comment $j += 2; $cc = $nc; for (; $j < $len; $j++) { $pc = $cc; $cc = substr($txt,$j,1); last if (($cc eq '/')&&($pc eq '*')); } next; } elsif (($cc eq '/')&&($nc eq '/')) { last; } $ntxt .= $cc; } return $ntxt; } sub add_2_hash($$$) { my ($rh, $ival, $sfn) = @_; $ival = trim_all($ival); if (defined ${$rh}{$ival}) { ${$rh}{$ival} .= "|$sfn"; } else { ${$rh}{$ival} = "$sfn"; } } # lines like # #if !(defined(_POSIX_MONOTONIC_CLOCK) && _POSIX_MONOTONIC_CLOCK >= 0 && defined(CLOCK_MONOTONIC)) sub parse_defines_in_line($) { my ($ival) = @_; my ($len,$j,$c,$tag,$hadd); $len = length($ival); my @a = (); $tag = ''; for ($j = 0; $j < $len; $j++) { $c = substr($ival,$j,1); if ($c =~ /\w/) { $tag .= $c; } else { if (length($tag)) { if ($tag eq 'defined') { $hadd = 1; if ($c ne '(') { $j++; for (; $j < $len; $j++) { $c = substr($ival,$j,1); last if ($c eq '('); # found the openning '(' last if (!($c =~ /\s/)); # but also abort on NOT space } } if ($c eq '(') { $tag = ''; $j++; for (; $j < $len; $j++) { $c = substr($ival,$j,1); last if ($c eq ')'); $tag .= $c; } if (($c eq ')')&&(length($tag))) { push(@a,trim_all($tag)); } } } } $tag = ''; } } return @a; } sub process_files($) { my ($rfl) = shift; my $cnt = scalar @{$rfl}; my ($msg, $ityp, $ival, $lnn); prt( "Processing $cnt files...\n" ); my %hash = (); foreach my $ff (@{$rfl}) { my $sfn = sub_root_name($ff); if (open INF, "<$ff") { my @lines = <INF>; close INF; $cnt = scalar @lines; $total_lines += $cnt; $msg = sprintf( "Doing %5d lines, from [$sfn]...", $cnt ); prt( "[dbg03] $msg\n" ) if ($dbg03); $lnn = 0; foreach my $line (@lines) { $lnn++; chomp $line; if ($line =~ /\s*#\s*if(\w*)\s+(.+)$/) { $ityp = $1; $ival = trim_comments_from_line($2); if (length($ityp) == 0) { if ($ival =~ /^\d+$/) { prt( "[dbg04] Line:$lnn:d: #if [$ival]\n" ) if ($dbg04); } else { prt( "Line:$lnn:0: #if [$ival]\n" ); my @defs = parse_defines_in_line($ival); foreach $ityp (@defs) { add_2_hash(\%hash, $ityp, $sfn); } } } else { if ($ival =~ /\w+/) { prt( "[dbg04] Line:$lnn: #if".$ityp." [$ival]\n" ) if ($dbg04); } elsif ($ival =~ /^\d+$/) { prt( "[dbg04] Line:$lnn: #if".$ityp." [$ival]\n" ) if ($dbg04); } else { prt( "Line:$lnn:1: #if".$ityp." [$ival]\n" ); } add_2_hash(\%hash, $ival, $sfn); } } } } else { prt( "ERROR: FAILED TO OPEN FILE [$ff]!\n" ); } } return \%hash; } sub show_hash($) { my ($rh) = @_; my $cnt = scalar keys(%{$rh}); prt( "\nGot $cnt 'ifdef' to show...\n" ); $total_ifdef += $cnt; my ($min,$len,$key,$val,$msg,$tmp); $msg = ''; $tmp = ''; foreach $key (sort keys %{$rh}) { $len = length($key); $min = $len if ($len > $min); } foreach $key (sort keys %{$rh}) { if ($key =~ /^HAVE/) { $tmp .= ' ' if length($tmp); $tmp .= $key; if (length($tmp) > 100) { $msg .= "\n" if length($msg); $msg .= $tmp; $tmp = ''; } } } if (length($tmp)) { $msg .= "\n" if length($msg); $msg .= $tmp; $tmp = ''; } foreach $key (sort keys %{$rh}) { if ( !($key =~ /^HAVE/) ) { $tmp .= ' ' if length($tmp); $tmp .= $key; if (length($tmp) > 100) { $msg .= "\n" if length($msg); $msg .= $tmp; $tmp = ''; } } } if (length($tmp)) { $msg .= "\n" if length($msg); $msg .= $tmp; $tmp = ''; } $min = $max_max if ($min > $max_max); foreach $key (sort keys %{$rh}) { $val = ${$rh}{$key}; $key .= ' ' while (length($key) < $min); prt( "$key = $val\n" ); } prt( "And is simple list...\n" ); prt( "$msg\n" ); } process_dir($in_dir, \%exclude_dirs, \%exclude_files, \@files_list ); my $ref_hash = process_files( \@files_list ); show_hash($ref_hash); prt( "Shown $total_ifdef IF[[N]DEF], from $total_files files, $total_lines lines...\n" ); close_log($outfile,$load_log); exit(0); # eof