Generated: Sat Oct 24 16:35:20 2020 from hasmain.pl 2020/07/12 11.1 KB. text copy
#!/perl -w # NAME: hasmain.pl # AIM: Read a C/C++ file, and search for main() { } function ... # 12/07/2020 - Review # 09/08/2010 - Added UI # 20/11/2007 - geoff mclane - http://geoffair.net/mperl use strict; use warnings; use File::Basename; # split path ($name,$dir,$ext) = fileparse($file [, qr/\.[^.]*/] ) use Cwd; my $perl_base = 'C:\GTools\perl'; unshift(@INC,$perl_base); require 'logfile.pl' or die "Unable to load logfile.pl ...\n"; require 'chkmain.pl' or die "Unable to load chkmain.pl ...\n"; # log file stuff my ($LF); my $pgmname = $0; if ($pgmname =~ /\w{1}:\\.*/) { my @tmpsp = split(/\\/,$pgmname); $pgmname = $tmpsp[-1]; } my $outfile = $perl_base."\\temp.$pgmname.txt"; open_log($outfile); my $VERS = "0.0.1 2010-05-05"; # user variables my $in_file = ''; my $load_log = 0; my $show_includes = 0; my $show_missed = 0; my $verbosity = 0; ### program variables my @in_files = (); my @warnings = (); my $cwd = cwd(); my $os = $^O; my @missed_main = (); my %all_includes = (); my @with_main = (); my %done_files = (); my $tot_files = 0; sub VERB1() { return $verbosity >= 1; } sub VERB2() { return $verbosity >= 2; } sub VERB5() { return $verbosity >= 5; } sub VERB9() { return $verbosity >= 9; } sub pgm_exit($$) { my ($val,$msg) = @_; if (length($msg)) { $msg .= "\n" if (!($msg =~ /\n$/)); prt($msg) } close_log($outfile,$load_log); exit($val); } sub prtw($) { my ($tx) = shift; $tx =~ s/\n$//; prt("$tx\n"); push(@warnings,$tx); } sub show_warnings() { 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 show_with_main() { return if (!VERB5()); my $cnt = scalar @with_main; return if ($cnt == 0); my ($fil,$n,$d,@arr); my %directories = (); prt("[v5] Of $tot_files files, found $cnt with 'main' -\n"); foreach $fil (@with_main) { ($n,$d) = fileparse($fil); $directories{$d} = 1; prt(" $fil\n"); } @arr = sort keys %directories; my $cnt2 = scalar @arr; prt("[v5] Listed $cnt of $tot_files files, in $cnt2 dirs, with 'main'...\n"); if (VERB9()) { prt(' '.join("\n ", @arr)."\n"); prt("[v9] Listed $cnt2 dirs, with files, with 'main'...\n"); } } sub show_missed() { if (($show_missed || VERB9()) && @missed_main) { my $cnt = scalar @missed_main; my ($fil,$n,$d,@arr); my %directories = (); prt( "\n[v9] NOTE: $cnt of $tot_files, with NO 'main' ...\n" ); #prt( join("\n", @missed_main)."\n"); foreach $fil (@missed_main) { ($n,$d) = fileparse($fil); $directories{$d} = 1; prt(" $fil\n"); } @arr = sort keys %directories; my $cnt2 = scalar @arr; prt("Listed $cnt, of $tot_files, in $cnt2 dirs, with no 'main'\n"); #foreach $d (@arr) { # prt(" $d\n"); #} #prt("Listed $cnt2 dirs...\n"); prt("\n"); } } sub show_includes() { if ($show_includes && VERB9()) { my @arr = sort keys %all_includes; my $cnt = scalar @arr; my $line = ''; my ($inc,$len); if ($cnt) { prt("Total $cnt includes found, in $tot_files processed -\n"); #prt(join(", ", @arr)."\n"); foreach $inc (@arr) { $cnt = $all_includes{$inc}; $line .= "$cnt:$inc "; $len = length($line); if ($len > 100) { prt("$line\n"); $line = ''; } } prt("$line\n") if (length($line)); prt("Listed $cnt includes found, in $tot_files.\n"); } } } # remove anything trailing the included file name sub trim_include_tail { my ($inc) = shift; my $ill = length($inc); my $i = 0; ###prt( "Trimming [$inc]$ill ...\n" ); if ($ill) { my $ch = substr($inc,$i,1); if (($ch eq '"')||($ch eq '<')) { $i++; $ch = '>' if ($ch eq '<'); for ( ; $i < $ill; $i++) { my $ch2 = substr($inc,$i,1); if ($ch2 eq $ch) { $i++; last; } } $inc = substr($inc,0,$i); } } ###prt( "Returning [$inc]$i ...\n" ); return $inc; } sub get_includes { my ($fil) = shift; my $fndm = 0; my ($ccnt, $pline, $j, $k, $k2, $ch, $pch, $cline, $tline, $ll, $incomm, $tag, $fnd1, $comment); my ($lncomm, $wascomm); my @incs = (); if (open INF, "<$fil") { my @clines = <INF>; close INF; $ccnt = scalar @clines; $incomm = 0; $lncomm = 0; ###prt( "\nProcessing $ccnt lines of $fil ...\n" ); for ($k = 0; $k < $ccnt; $k++) { $cline = $clines[$k]; $k2 = $k + 1; chomp $cline; $tline = $cline; # trim_all($cline); $ll = length($tline); if ( !$incomm && ($tline =~ /^\s*#\s*include\s+(.*)$/)) { push(@incs,trim_include_tail($1)); next; # skip '#include <main/main.h>' like INCLUDE lines } $lncomm = 0; $pch = ''; for ($j = 0; $j < $ll; $j++) { $ch = substr($tline,$j,1); if ($incomm) { # only looking for CLOSE comment */ if (($ch eq '/') && ($pch eq '*')) { $incomm = 0; } } else { if ($ch eq '"') { # start of QUOTE $j++; # to next char $pch = $ch; for ( ; $j < $ll; $j++) { $ch = substr($tline,$j,1); if (($ch eq '"')&&($pch ne "\\")) { last; # out of here } $pch = $ch; } } elsif (($ch eq '*') && ($pch eq '/')) { # comment start /* until */ $incomm = 1; $wascomm = 1; } elsif (($ch eq '/') && ($pch eq '/')) { $j = $ll; # skip rest of line $lncomm = 1; } } $pch = $ch; } ###prt( "line $k2:[$tline]$ll ($incomm:$lncomm) $fnd1 $fndm\n" ); $wascomm = $incomm; $pline = $cline; } } else { prtw( "WARNING: Unable to open [$fil] file ... $! ...\n" ); } return @incs; } sub process_files($) { my ($ra) = @_; # \@in_files my ($cnt,$inc); foreach my $file (@{$ra}) { next if (defined $done_files{$file}); $done_files{$file} = 1; $tot_files++; my @arr = (); my $mo = ''; my $has = 0; if ( !chk_main( $file, \@arr ) ) { prt( "NOTE: NO MAIN FOUND in $file\n" ) if (VERB2()); push(@missed_main, $file); } else { push(@with_main, $file); $has = 1; $mo = "$file - HAS MAIN"; my $ac = scalar @arr; for (my $m = 0; $m < $ac; $m++) { $mo .= " - ln:".$arr[$m][0].": ". $arr[$m][1]; $mo .= " cond " . $arr[$m][2] if (length($arr[$m][2])); } prt( "$mo\n" ); } if ($show_includes) { my @is = get_includes($file); $cnt = scalar @is; if ($cnt) { foreach $inc (@is) { if (defined $all_includes{$inc}) { $all_includes{$inc}++; } else { $all_includes{$inc} = 1; } } if ($has) { prt( "And has $cnt include file - ". join(", ",@is) ."\n" ); } else { prt( "$file has $cnt include file - ". join(", ",@is) ."\n" ); } } } } } ######################################### ### MAIN ### parse_args(@ARGV); process_files( \@in_files ); show_missed(); show_includes(); show_with_main(); pgm_exit(0,""); ############################################# sub give_help { prt("$pgmname: version $VERS\n"); prt("Usage: $pgmname [options] in-file\n"); prt("Options:\n"); prt(" --help (-h or -?) = This brief help\n"); prt(" --verb[n] (-v) = Bump [or set] verbosity. (def=$verbosity)\n"); prt(" --load (-l) = Load LOG at end. ($outfile)\n"); prt(" --missed (-m) = Show files with NO main. (def=$show_missed)\n"); prt(" --includes (-i) = Also show included files. (def=$show_includes)\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,@arr,$fil,$len,$cnt); 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 =~ /^v/) { if ($sarg =~ /^v.*(\d+)$/) { $verbosity = $1; } else { while ($sarg =~ /^v/) { $verbosity++; $sarg = substr($sarg,1); } } prt("Verbosity = $verbosity\n") if (VERB1()); } elsif ($sarg =~ /^l/) { if ($sarg =~ /^ll/) { $load_log = 2; } else { $load_log = 1; } prt("Set to load log at end. ($load_log)\n") if (VERB1()); } elsif ($sarg =~ /^m/) { $show_missed = 1; prt("Set file with NO main, at end. (def=$show_missed)\n") if (VERB1()); } elsif ($sarg =~ /^i/) { $show_includes = 1; prt("Set to also show includes. (def=$show_includes)\n") if (VERB1()); } else { pgm_exit(1,"ERROR: Invalid argument [$arg]! Try -?\n"); } } elsif ($arg =~ /^\@(.+)$/) { $sarg = $1; if (!open INF, "<$sarg") { pgm_exit(1,"ERROR: Unable to open '$sarg', from '$arg'!\n"); } @arr = <INF>; close INF; $cnt = 0; foreach $fil (@arr) { chomp $fil; $fil = trim_all($fil); $len = length($fil); next if ($len == 0); next if ($fil =~ /^\#/); if (-f $fil) { $cnt++; $in_file = $fil; push(@in_files,$in_file); } else { prtw("WARNING: Unable to stat file '$fil'\n"); } } if ($cnt) { prt("Added $cnt files to input..\n") if (VERB1()); } else { pgm_exit(1,"ERROR: No valid files in '$sarg'!\n"); } } else { $in_file = $arg; push(@in_files,$in_file); prt("Added input [$in_file]\n"); } shift @av; } if (!@in_files) { pgm_exit(1,"ERROR: No INPUT file found in command!\n"); } } # eof - hasmain.pl