#!/usr/bin/perl -w # NAME: listincs.pl # AIM: Given a C/C++ file, skip comments, and list the 'include' files found # 13/04/2015 - Allow an input directory, and scan all 'c' and 'h' files found # 27/10/2013 geoff mclane http://geoffair.net/mperl use strict; use warnings; use File::Basename; # split path ($name,$dir,$ext) = fileparse($file [, qr/\.[^.]*/] ) use Cwd; my $os = $^O; my $perl_dir = '/home/geoff/bin'; my $PATH_SEP = '/'; my $temp_dir = '/tmp'; if ($os =~ /win/i) { $perl_dir = 'C:\GTools\perl'; $temp_dir = $perl_dir; $PATH_SEP = "\\"; } unshift(@INC, $perl_dir); require 'lib_utils.pl' or die "Unable to load 'lib_utils.pl' Check paths in \@INC...\n"; # log file stuff our ($LF); my $pgmname = $0; if ($pgmname =~ /(\\|\/)/) { my @tmpsp = split(/(\\|\/)/,$pgmname); $pgmname = $tmpsp[-1]; } my $outfile = $temp_dir.$PATH_SEP."temp.$pgmname.txt"; open_log($outfile); # user variables my $VERS = "0.0.1 2013-10-27"; my $load_log = 0; my $in_file = ''; my @in_files = (); my $verbosity = 0; my $out_file = ''; my $src_dir = ''; my $recursive = 1; # ### DEBUG ### my $debug_on = 0; my $def_src = 'F:\FG\18\openssl'; my $def_file = 'F:\FG\18\openssl\crypto\o_dir.c'; ### program variables my @warnings = (); my $cwd = cwd(); my %doneincs = (); my %included = (); my %shown = (); my %sys_files = ( 'errno.h' => 1, 'unistd.h' => 1, 'sys/stat.h' => 1, 'sys/socket.h' => 1, 'tcp.h' => 1, 'netdb.h' => 1, 'winsock2.h' => 1, 'ws2tcpip.h' => 1, 'windows.h' => 1, 'stdio.h' => 1, 'stddef.h' => 1, 'string.h' => 1, 'malloc.h' => 1, 'io.h' => 1, 'fcntl.h' => 1, 'stdlib.h' => 1, 'unixlib.h' => 1, 'screen.h' => 1, 'sys/types.h' => 1, 'winsock.h' => 1, 'netinet/in.h' => 1, 'sys/time.h' => 1, 'sys/bsdskt.h' => 1, 'sys/select.h' => 1, 'novsock2.h' => 1, 'sys/param.h' => 1, 'time.h' => 1, 'socket.h' => 1, 'in.h' => 1, 'inet.h' => 1, 'sys/filio.h' => 1, 'arpa/inet.h' => 1, 'sys/fcntl.h' => 1, 'sys/ioctl.h' => 1, 'unixio.h' => 1, 'socketshr.h' => 1, 'limits.h' => 1, 'dirent.h' => 1, 'libfildef.h' => 1, 'lib$routines.h' => 1, 'strdef.h' => 1, 'str$routines.h' => 1, 'stsdef.h' => 1, 'tchar.h' => 1 ); #36: LPdir.h loc hdr NF 0 #32: descrip.h sys hdr NF 0 #33: namdef.h sys hdr NF 0 #34: rmsdef.h sys hdr NF 0 my %specials = ( 'ioLib.h' => 1, 'tickLib.h' => 1, 'sysLib.h' => 1, 'vxWorks.h' => 1, 'sockLib.h' => 1, 'taskLib.h' => 1, 'OS.h' => 1 ); sub in_sys_includes($$) { my ($inc,$finc) = @_; return 1 if (defined $sys_files{$inc}); return 1 if (defined $sys_files{$finc}); return 1 if (defined $specials{$inc}); return 1 if (defined $specials{$finc}); $inc = lc($inc); $finc = lc($finc); return 1 if (defined $sys_files{$inc}); return 1 if (defined $sys_files{$finc}); return 0; } sub VERB1() { return $verbosity >= 1; } sub VERB2() { return $verbosity >= 2; } sub VERB5() { return $verbosity >= 5; } sub VERB9() { return $verbosity >= 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" ) if (VERB9()); } } 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); } my $done_scan = 0; my $dirs_found = 0; my $files_found = 0; my %dir_scan = (); sub scan_directory($$); sub scan_directory($$) { my ($dir,$lev) = @_; if (! opendir(DIR,$dir) ) { prtw("WARNING: Failed to open directory $dir!\n"); return; # nothing to do but return } my @files = readdir(DIR); closedir(DIR); my ($file,$ff,$ra); ut_fix_directory(\$dir); my @dirs = (); $dirs_found++; foreach $file (@files) { next if ($file eq '.'); next if ($file eq '..'); $ff = $dir.$file; if (-d $ff) { push(@dirs,$ff); } elsif (-f $ff) { # keep everything, or just likely sources - no EVERYTHING # keep as hash or array - choose array, since can push full and file name # but a hash on file name with an array of locations seems best $dir_scan{$file} = [] if (!defined $dir_scan{$file}); $ra = $dir_scan{$file}; push(@{$ra},$dir); # this file was found in this array of directories $files_found++; } else { pgm_exit(1,"ERROR: WHAT IS THIS [$ff] if not file or folder!!! FIX ME!!!\n"); } } foreach $ff (@dirs) { scan_directory($ff,($lev+1)); } if ($lev == 0) { prt("In scan of $dirs_found Directories, found $files_found files...\n"); } } sub scan_base() { $done_scan = 1; scan_directory($src_dir,0); } sub process_in_file($); sub process_in_file($) { my ($inf) = @_; if (! open INF, "<$inf") { pgm_exit(1,"ERROR: Unable to open file [$inf]\n"); } my @lines = ; close INF; my $lncnt = scalar @lines; scan_base() if (length($src_dir) && !$done_scan); my $hdr = "Processing $lncnt lines, from [$inf]..."; my ($line,$inc,$lnn,$incomm,$tline,$len,$i,$ch,$pc,$nc,$i2,$nline,$rda,$typ,$sys,$ff,$dc); my ($finc,$tmp,@arr,$show); $lnn = 0; $incomm = 0; $ch = ''; my @incs = (); foreach $line (@lines) { chomp $line; $tline = trim_all($line); $lnn++; $len = length($tline); next if ($len == 0); $nline = ''; for ($i = 0; $i < $len; $i++) { $pc = $ch; $i2 = $i + 1; $ch = substr($tline,$i,1); $nc = ($i2 < $len) ? substr($tline,$i2,1) : ''; if ($incomm) { if (($ch eq '/')&&($pc eq '*')) { $incomm = 0; } next; } # not in a comment if (($ch eq '/') && ($nc eq '*')) { # start comment $incomm = 1; next; } if (($ch eq '/') && ($nc eq '/')) { last; } $nline .= $ch; } if ($nline =~ /^\s*#\s*include\s+(.+)$/) { $inc = trim_all($1); $typ = 'unk'; $sys = 'unk'; $dc = 0; if ($inc =~ /^"/) { $inc = substr($inc,1); $inc =~ s/"$//; $sys = 'loc'; } elsif ($inc =~ /^$//; $sys = 'sys' } if (is_h_source($inc)) { $typ = 'hdr'; } elsif (is_c_source($inc)) { $typ = 'src'; } $finc = $inc; if ($done_scan) { if (defined $dir_scan{$inc}) { $rda = $dir_scan{$inc}; $ch = ${$rda}[0]; $ff = $ch.$inc; if (-f $ff) { if (!defined $doneincs{$ff}) { $doneincs{$ff} = 1; push(@incs,$ff); } } else { prtw("WARNING: File NOT found [$ff]\n"); } } else { if ($inc =~ /\//) { @arr = split(/\//,$inc); $dc = scalar @arr - 1; $tmp = $arr[-1]; if (defined $dir_scan{$tmp}) { $rda = $dir_scan{$tmp}; $ch = ${$rda}[0]; $ff = $ch.$tmp; if (-f $ff) { $inc = $tmp; if (!defined $doneincs{$ff}) { $doneincs{$ff} = 1; push(@incs,$ff); } } else { prtw("WARNING: File NOT found [$ff]\n"); } } else { $ch = 'Nf'; } } else { $ch = 'NF'; } } } else { $ch = 'NS'; } $ff = $ch.$inc; if (!defined $shown{$ff}) { $shown{$ff} = 1; $show = 1; if ($ch =~ /^N(f|F|S)$/) { $show = 0 if ( in_sys_includes($inc,$finc) ); } if ($show) { prt("$hdr\n") if (length($hdr)); $hdr = ''; prt("$lnn: $inc $sys $typ $ch $dc\n"); } } $included{$inc} = [] if (!defined $included{$inc}); $rda = $included{$inc}; push(@{$rda}, [$lnn, $inf, $sys, $typ, $ch, $dc]); } #if ($nline =~ /^\s*#\s*include\s+(<|")(.+)(<|")/) { # $inc = $2; # prt("$lnn: $inc\n"); #} } if ($recursive) { foreach $inf (@incs) { process_in_file($inf); } } } sub process_in_files() { foreach $in_file (@in_files) { process_in_file($in_file); } } ######################################### ### MAIN ### parse_args(@ARGV); ##process_in_file($in_file); process_in_files(); pgm_exit(0,""); ######################################## sub scan_dir($$) { my ($dir,$rin) = @_; if (! opendir(DIR,$dir) ) { prtw("WARNING: Failed to open directory $dir!\n"); return; # nothing to do but return } my @files = readdir(DIR); closedir(DIR); my ($file,$ff,$ra); ut_fix_directory(\$dir); my @dirs = (); $dirs_found++; foreach $file (@files) { next if ($file eq '.'); next if ($file eq '..'); $ff = $dir.$file; if (-d $ff) { push(@dirs,$ff); } elsif (-f $ff) { if (is_c_source($file) || is_h_source($file)) { ${$rin} = $ff; push(@in_files,$ff); } } } } sub need_arg { my ($arg,@av) = @_; pgm_exit(1,"ERROR: [$arg] must have a 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 =~ /^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 =~ /^o/) { need_arg(@av); shift @av; $sarg = $av[0]; $out_file = $sarg; prt("Set out file to [$out_file].\n") if (VERB1()); } elsif ($sarg =~ /^b/) { need_arg(@av); shift @av; $sarg = $av[0]; $src_dir = $sarg; if (! -d $src_dir) { pgm_exit(1,"ERROR: Base directory $src_dir does NOT exist!\n"); } prt("Set src directory to [$src_dir].\n") if (VERB1()); } elsif ($sarg =~ /^c/) { $src_dir = $cwd; if (! -d $src_dir) { pgm_exit(1,"ERROR: Base directory $src_dir does NOT exist!\n"); } prt("Set base src directory to [$src_dir].\n") if (VERB1()); } else { pgm_exit(1,"ERROR: Invalid argument [$arg]! Try -?\n"); } } else { if (-d $arg) { scan_dir($arg,\$in_file); } elsif (-f $arg) { $in_file = $arg; prt("Set input to [$in_file]\n") if (VERB1()); push(@in_files,$arg); } } shift @av; } if ($debug_on) { prtw("WARNING: DEBUG is ON!\n"); if (length($in_file) == 0) { $in_file = $def_file; prt("Set DEFAULT input to [$in_file]\n"); } if (length($src_dir) == 0) { $src_dir = $def_src; } $load_log = 1; } if (length($in_file) == 0) { pgm_exit(1,"ERROR: No input files found in command!\n"); } if (! -f $in_file) { pgm_exit(1,"ERROR: Unable to find in file [$in_file]! Check name, location...\n"); } } sub give_help { prt("$pgmname: version $VERS\n"); prt("Usage: $pgmname [options] in-file\n"); prt("Options:\n"); prt(" --help (-h or -?) = This help, and exit 0.\n"); prt(" --verb[n] (-v) = Bump [or set] verbosity. def=$verbosity\n"); prt(" --load (-l) = Load LOG at end. ($outfile)\n"); prt(" --out (-o) = Write output to this file.\n"); prt(" --base (-b) = Set base directory to scan finding includes.\n"); prt(" --cwd (-c) = Set base directory to current work directory.\n"); } # eof - template.pl