getsrclist.pl to HTML.

index -|- end

Generated: Sat Oct 12 17:23:02 2013 from getsrclist.pl 2013/07/11 19 KB. text copy

#!/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 = <INF>;
    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 = <FIL>;
        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 <file>   (-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 <num>    (-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

index -|- top

checked by tidy  Valid HTML 4.01 Transitional