#!/usr/bin/perl -w #< getsrclist.pl - read make output, and get src file list use strict; use warnings; use File::Basename; # split path ($name,$dir) = fileparse($ff); or ($nm,$dir,$ext) = fileparse($fil, qr/\.[^.]*/); use Cwd; use File::stat; my $os = $^O; my $perl_base = '/home/geoff/bin'; my $PATH_SEP = '/'; my $util_lib = 'lib_utils.pl'; if ($os =~ /win/i) { $perl_base = 'C:\GTools\perl'; $PATH_SEP = "\\"; } unshift(@INC,$perl_base); require $util_lib or die "Unable to load '$util_lib' ...\n"; # log file stuff our ($LF); my $pgmname = $0; if ($pgmname =~ /(\\|\/)/) { my @tmpsp = split(/(\\|\/)/,$pgmname); $pgmname = $tmpsp[-1]; } my $outfile = '/tmp/temp.'.$pgmname.'.txt'; if ($os =~ /win/i) { $outfile = $perl_base.$PATH_SEP."temp.$pgmname.txt"; } open_log($outfile); my $pgm_vers = "0.0.3 2013-07-11"; #my $pgm_vers = "0.0.2 2013-07-05"; #my $pgm_vers = "0.0.1 2012-06-12"; my @in_files = (); my $base_folder = ''; my $cmake_srcs = ''; my $cmake_file = ''; my @warnings = (); my $load_log = 0; my $verbosity = 0; my $remove_cnt = 0; my $total_dirs = 0; my $total_files = 0; my $total_lines = 0; my $total_bytes = 0; my $out_file = ''; # debug my $debug_on = 0; my $def_file = 'C:\FG\18\build-motif\bldlog-u.txt'; my $dbg01 = 0; # show each directory processed... my $dbg02 = 0; # show sub-directory processed... sub VERB1() { return $verbosity >= 1; } sub VERB2() { return $verbosity >= 2; } sub VERB5() { return $verbosity >= 5; } sub VERB9() { return $verbosity >= 9; } sub process_dir($$$); 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 pgm_exit($$) { my ($val,$msg) = @_; show_warnings(); prt($msg) if (length($msg)); close_log($outfile,$load_log); exit($val); } sub full_cmake_line($) { my ($line) = shift; my $len = length($line); my $inquot = 0; my $inbrac = 0; my ($i,$ch,$qc); for ($i = 0; $i < $len; $i++) { $ch = substr($line,$i,1); if ($inbrac) { if ($inquot) { $inquot = 0 if ($ch eq $qc); } elsif ($ch eq '"') { $inquot = 1; $qc = $ch; } elsif ($ch eq ')') { $inbrac--; if ($inbrac == 0) { return 1; } } } else { if ($inquot) { $inquot = 0 if ($ch eq $qc); } elsif ($ch eq '"') { $inquot = 1; $qc = $ch; } elsif ($ch eq '(') { $inbrac++; } } } return 0; } sub split_cmake_line($) { my ($line) = shift; my $len = length($line); my $inquot = 0; my $inbrac = 0; my ($i,$ch,$qc,$command,$hadsp); my @arr = (); # got nothing so far $command = ''; # start the collection $hadsp = 0; # had no space yet for ($i = 0; $i < $len; $i++) { $ch = substr($line,$i,1); if ($ch eq '(') { last; # found first '(' } elsif ( !($ch =~ /\s/) ) { $command .= $ch; } else { # have a SPACE if (length($command)) { # already had some non-space - trailing space # should check if the next sig char is the '(' } # else have not yet started command, # so ignore this beginning space } } if (($ch ne '(')||(length($command)==0)) { prtw("WARNING: Option line did not conform! [$line]\n"); return \@arr; } push(@arr,$command); # push first item 'OPTION' or 'option' $command = ''; # collect space spearated items, skipping spaces in quoted strings for (; $i < $len; $i++) { $ch = substr($line,$i,1); if ($inbrac) { if ($inquot) { $command .= $ch; $inquot = 0 if ($ch eq $qc); } else { if ($ch =~ /\s/) { push(@arr,$command) if (length($command)); $command = ''; } else { # not a space if ($ch eq ')') { $inbrac--; if ($inbrac == 0) { last; } } else { # not end bracket $command .= $ch; if ($ch eq '"') { $inquot = 1; $qc = $ch; } } } } } else { if ($inquot) { $inquot = 0 if ($ch eq $qc); } elsif ($ch eq '"') { $inquot = 1; $qc = $ch; } elsif ($ch eq '(') { $inbrac++; } } } push(@arr,$command) if (length($command)); return \@arr; } sub process_cmake_file($) { my $fil = shift; my @cmake_lines = (); pgm_exit(1,"ERROR: Unable to open file [$fil]\n") if ( ! open INF, "<$fil" ); my @lines = ; close INF; my $lncnt = scalar @lines; my ($i,$line,$i2,$nxln); prt("Processing $lncnt lines, from [$fil]\n"); for ($i = 0; $i < $lncnt; $i++) { $line = $lines[$i]; $line = trim_all($line); next if ($line =~ /^\#/); $i2 = $i + 1; while (($i2 < $lncnt) && !(full_cmake_line($line))) { $i++; $i2 = $i + 1; $nxln = $lines[$i]; $nxln = trim_all($nxln); next if ($nxln =~ /^\#/); $line .= ' '; $line .= $nxln; } push(@cmake_lines,trim_all($line)); } $lncnt = scalar @cmake_lines; prt("Got $lncnt cmake lines, from [$fil]\n"); if (VERB9()) { foreach $line (@cmake_lines) { prt("$line\n"); } } return \@cmake_lines; } sub process_dir($$$) { my ($dir,$ra,$lev) = @_; my @dirs = (); my ($file,$ff,$cnt); if (opendir( DIR, $dir )) { $total_dirs++; prt("Reading [$dir]...\n"); my @files = readdir(DIR); closedir(DIR); $dir .= '/' if !($dir =~ /\/$/); foreach $file (@files) { next if ($file eq '.'); next if ($file eq '..'); $ff = $dir.$file; if ( -d $ff ) { push(@dirs,$ff); } elsif ( -f $ff ) { push(@{$ra},$ff); $total_files++; } else { # a link or .... } } } else { prtw("WARNING: Unable to open folder [$dir]... $!...\n"); } if (@dirs) { my ($cnt,$itm); $cnt = scalar @dirs; prt( "[$dbg02] $lev: Found $cnt subs in [$dir]...\n" ) if ($dbg02); foreach $itm (@dirs) { process_dir($itm,$ra,($lev + 1)); } } if ($lev == 0) { $cnt = scalar @{$ra}; prt("Found $cnt file items, in scan of [$dir]\n"); } return $ra; } sub get_adj_folder($) { my $tline = shift; $tline =~ s/`//; $tline =~ s/'//; $tline = trim_all($tline); $tline =~ s/^\///; if ($remove_cnt) { my @arr = split(/\//,$tline); my $cnt = scalar @arr; if ($cnt >= $remove_cnt) { my ($i); $tline = ''; for ($i = $remove_cnt; $i < $cnt; $i++) { $tline .= '/' if (length($tline)); $tline .= $arr[$i]; } } } return $tline; } # find gcc compile lines, and add the source being compiled # skip DUPLICATES sub process_file($) { my ($in) = @_; my ($i,$line,$tline,$lnn,$srccnt); my @src_files = (); my %dupes = (); $srccnt = 0; if (open FIL, "<$in") { my @lines = ; close FIL; my $cnt = scalar @lines; $in =~ s/^\.(\\|\/)//; $lnn = sprintf("%5d", $cnt); $in .= ' ' while (length($in) < 8+1+3); prt("Got $lnn lines, from [$in] to process...\n"); my ($name,$dir) = fileparse($in); my (@arr,$itm,$ff); for ($i = 0; $i < $cnt; $i++) { $total_lines++; $line = $lines[$i]; $total_bytes += length($line); chomp $line; $tline = trim_all($line); if ($tline =~ /^libtool:\s+/) { $tline = substr($tline,8); $tline = trim_all($tline); } if ($tline =~ /^compile:\s+/) { $tline = substr($tline,8); $tline = trim_all($tline); } if ($tline =~ /^link:\s+/) { $tline = substr($tline,5); $tline = trim_all($tline); } if (($tline =~ /^\s*gcc\s+/) || ($tline =~ /^\s*g\+\+\s+/) || ($tline =~ /^\s*cc\s+/)) { @arr = space_split($tline); foreach $itm (@arr) { $itm = path_d2u($itm); $itm =~ s/`//g; $itm =~ s/'//g; $itm =~ s/^\.\///; next if ($itm =~ /^-/); next if (($itm eq 'gcc')||($itm eq 'g++')||($itm eq 'cc')); next if ( !($itm =~ /\./) ); ###$ff = $dir.$itm; if ( is_c_source($itm) ) { # && ( -f $ff ) ) { $ff = $base_folder.$itm; $ff = path_d2u($ff); if (! defined $dupes{$ff}) { prt("$ff\n") if (VERB9()); push(@src_files,$ff); $dupes{$ff} = 1; $srccnt++; } } } } elsif ($tline =~ /^make\[\d+\]:\s+Entering\s+directory\s+/) { $tline =~ s/^make\[\d+\]:\s+Entering\s+directory\s+//; $tline = get_adj_folder($tline); prt("Enter: $tline\n") if (VERB9()); $base_folder = $tline; ut_fix_directory(\$base_folder); $srccnt = 0; } elsif ($tline =~ /^make\[\d+\]:\s+Leaving\s+directory\s+/) { $tline =~ s/^make\[\d+\]:\s+Leaving\s+directory\s+//; $tline = get_adj_folder($tline); prt("Leave: $tline - $srccnt sources\n") if (VERB9()); } elsif ($tline =~ /^mv\s+/) { } elsif ($tline =~ /^make(\s|\[)+/) { } elsif ($tline =~ /^test\s+/) { } elsif ($tline =~ /^Making\s+/) { } elsif ($tline =~ /\s*In\s+function\s+/) { } elsif ($tline =~ /\s*In\s+file\s+/) { } elsif ($tline =~ /^\/*bin\/bash\s+/) { } elsif ($tline =~ /:\d+:\d+:\s+warning:\s+/) { } elsif ($tline =~ /:\d+:\d+:\s+note:\s+/) { } elsif ($tline =~ /^from\s+/) { } elsif ($tline =~ /^rm\s+/) { } elsif ($tline =~ /^ln\s+/) { } elsif ($tline =~ /^ar\s+/) { } elsif ($tline =~ /^ranlib\s+/) { } elsif ($tline =~ /^Created\s+/) { } elsif ($tline =~ /^Appending\s+/) { } elsif ($tline =~ /^\.\.\//) { } elsif ($tline =~ /^\(/) { } else { prt("CHECK: $tline\n") if (VERB9()); } } @src_files = sort @src_files; $cnt = scalar @src_files; prt("Got list of $cnt source files\n"); $line = join("\n",@src_files)."\n"; if (VERB5()) { prt("List of $cnt source files\n"); $cnt = 0; foreach $line (@src_files) { $cnt++; prt("$cnt: $line\n"); } prt("Done list of $cnt sources\n"); } if (length($out_file)) { write2file($line,$out_file); prt("List written to $out_file\n"); } else { prt("No -o file found in command\n"); } } else { prtw("WARNING: Unable to open file [$in]!\n"); } return \@src_files; } sub mycmp_decend { return -1 if ( ${$a}[0] > ${$b}[0] ); return 1 if ( ${$a}[0] < ${$b}[0] ); return 0; } sub process_input() { my ($in); my @files = (); foreach $in (@in_files) { if (-f $in) { process_file($in); } elsif (-d $in) { process_dir($in,\@files,0); } else { pgm_exit(1,"ERROR: Input [$in] is NOT file or directory!\n"); } } foreach $in (@files) { process_file($in); } } sub get_items_in($$) { my ($ra,$find) = @_; # $ref_arr, iaxclient_lib_SOURCES my ($line,$ref_arr,$cnt,$i,$src); my @src_arr = (); $find = '_SRCS' if (length($find) == 0); my %dupes = (); foreach $line (@{$ra}) { ###if ((($line =~ /^set\b/i)||($line =~ /^\s*list/i)) && ($line =~ /$find/)) { if (($line =~ /^set\b/i) && ($line =~ /$find/)) { $ref_arr = split_cmake_line($line); $cnt = scalar @{$ref_arr}; for ($i = 0; $i < $cnt; $i++) { $src = ${$ref_arr}[$i]; next if ($src eq $find); next if ($src =~ /$find/); next if ($src =~ /^set$/i); next if ($src =~ /^list$/i); next if ($src =~ /^APPEND$/i); if (! defined $dupes{$src} ) { push(@src_arr,$src); $dupes{$src} = 1; } } } } #return $ref_arr; @src_arr = sort @src_arr; $cnt = scalar @src_arr; prt("Found $cnt sources, using [$find]\n"); if (VERB9()) { $cnt = 0; foreach $line (@src_arr) { $cnt++; prt("$cnt: $line\n"); } prt("Done list of $cnt sources\n"); } return \@src_arr; } sub compare_srcs($$$$) { my ($f1,$ra1,$f2,$ra2) = @_; # $cmake_file,$ref_items,$in_files[0],$ref_srcs); my $cnt1 = scalar @{$ra1}; my $cnt2 = scalar @{$ra2}; prt("Comparing $cnt1, from $f1,\n". "with $cnt2, from $f2...\n"); my ($fil1,$fil2,$fnd); my @nfin2 = (); my @nfin1 = (); foreach $fil1 (@{$ra1}) { $fnd = 0; foreach $fil2 (@{$ra2}) { if ($fil1 eq $fil2) { $fnd = 1; last; } } if (!$fnd) { push(@nfin2,$fil1); } } foreach $fil1 (@{$ra2}) { $fnd = 0; foreach $fil2 (@{$ra1}) { if ($fil1 eq $fil2) { $fnd = 1; last; } } if (!$fnd) { push(@nfin1,$fil1); } } $cnt1 = scalar @nfin2; $cnt2 = scalar @nfin1; prt("\nFound $cnt1 file 1 sources, $f1, not found in 2\n"); prt(join("\n",sort @nfin2)."\n"); prt("\nFound $cnt2 file 2 sources, $f2, not found in 1\n"); prt(join("\n",sort @nfin1)."\n"); } ######################################### ###### MAIN ###### process_args(@ARGV); my $ref_srcs = process_file($in_files[0]); if (length($cmake_file)) { my $ref_arr = process_cmake_file($cmake_file); my $ref_items = get_items_in( $ref_arr, $cmake_srcs ); compare_srcs($cmake_file,$ref_items,$in_files[0],$ref_srcs); } ### prt("$total_dirs dirs, $total_files files, $total_lines lines, $total_bytes bytes.\n"); pgm_exit(0,""); #################################### sub give_help { prt("$pgmname version $pgm_vers\n"); prt("Usage: [options] input\n"); prt("Options:\n"); prt(" --help (-h,-?) = This help and exit.\n"); prt(" --load (-l) = Load log at end.\n"); prt(" --out (-o) = Set output file.\n"); prt(" --verb[Num] (-v) = Bump [or set] verbosity. (def=$verbosity)\n"); prt(" --cmp cmake (-c) = Compare sources with those in CMakeLists.txt\n"); prt(" --rem (-r) = Remove num paths from sources.\n"); } sub need_arg { my ($arg,@av) = @_; pgm_exit(1,"ERROR: Need argument following [$arg]!\n") if (!@av); } sub process_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/) || ($sarg eq '?')) { give_help(); pgm_exit(0,"Help exit 0"); } elsif ($sarg =~ /^l/) { $load_log = 1; prt("Set to load log at end.\n") if (VERB1()); } elsif ($sarg =~ /^v/) { if ($sarg =~ /^v.*(\d+)$/) { $verbosity = $1; } else { while ($sarg =~ /^v/) { $verbosity++; $sarg = substr($sarg,1); } } prt("Set verbosity to $verbosity.\n") if (VERB1()); } elsif ($sarg =~ /^o/) { need_arg(@av); shift @av; $sarg = $av[0]; $out_file = $sarg; prt("Set output file to $out_file.\n") if (VERB1()); } elsif ($sarg =~ /^r/) { need_arg(@av); shift @av; $sarg = $av[0]; if ($sarg =~ /^\d+$/) { $remove_cnt = $sarg; prt("Set to remove $sarg paths.\n") if (VERB1()); } else { pgm_exit(1,"Argument $arg must be followed by an integer.\n"); } } elsif ($sarg =~ /^c/) { need_arg(@av); shift @av; $sarg = $av[0]; $cmake_file = $sarg; if (! -f $cmake_file) { pgm_exit(1,"ERROR: Can not locate cmake file $cmake_file\n"); } prt("Set cmake file to $cmake_file.\n") if (VERB1()); } else { pgm_exit(1,"ERROR: Unknown option [$arg]! Try -?\n"); } } else { push(@in_files,$arg); prt("Added input [$arg]\n") if (VERB1()); } shift @av; } if ($debug_on) { prtw("WARNING: DEBUG is ON\n"); if ( ! @in_files ) { push(@in_files,$def_file); prt("Added DEFAULT input [$def_file]\n"); } #$verbosity = 5; #$load_log = 1; } if ( ! @in_files ) { pgm_exit(1,"ERROR: No input found in command!\n"); } } # eof - getsrclist.pl eof