shwmake.pl to HTML.

index -|- end

Generated: Tue Feb 2 17:54:56 2010 from shwmake.pl 2009/09/19 12.2 KB.

#!/usr/bin/perl -w
#< shwmake.pl: show some details from a make process, where make was fully redirected
# to the file to analyse, like 'make > make.txt 2>&1'
use strict;
use warnings;
use File::Basename;
use Cwd;
#unshift(@INC, '/home/geoff/bin');
unshift(@INC, 'C:\GTools\perl');
#require "logfileu.pl" or die "ERROR: Unable to load logfileu.pl";
require "logfile.pl" or die "ERROR: Unable to load logfile.pl";
# log file stuff
our ($LF);
my $pgmname = $0;
if ($pgmname =~ /\//) {
   my @tmpsp = split(/\//,$pgmname);
   $pgmname = $tmpsp[-1];
}
my $outfile = "/tmp/temp.".$pgmname.".txt";
open_log($outfile);
#my $in_file = '/home/geoff/projects/tests/liboil/make.txt';
my $in_file = 'S:/geoff/projects/tests/liboil/make.txt';
# features
my $max_max = 30; # maximum indent
my $load_log = 1;
my $use_trim_all = 1;
my %cmds_of_interest = (
   'gcc' => 1,
   'ar'  => 2,
   'creating' => 3
   );
my @warnings = ();
my @extra_lines = ();
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 add_to_cmd_hash($$) {
   my ($rh,$cmd) = @_;
   if (defined ${$rh}{$cmd}) {
      ${$rh}{$cmd}++;
   } else {
      ${$rh}{$cmd} = 1;
   }
}
sub get_next_non_space($) {
   my ($txt) = shift;
   my $item = '';
   my $len = length($txt);
   my ($i,$c);
   for ($i = 0; $i < $len; $i++) {
      $c = substr($txt,$i,1);
      next if ($c =~ /\s/);
      $item = $c;
      $i++;
      for (; $i < $len; $i++) {
         $c = substr($txt,$i,1);
         last if ($c =~ /\s/);
         $item .= $c;
      }
      last;
   }
   return $item;
}
sub get_gcc_out($$) {
   my ($val,$lnn) = @_;
   my $ind = index($val,'-o');
   my $tag = '';
   my ($sval,$tmp);
   if ($ind > 0) {
      $sval = substr($val,($ind + 2));
      $sval = substr($sval,1) while ($sval =~ /^\s/);
      $tag = get_next_non_space($sval);
      if (!($tag =~ /\.o$/)) {
         # try for NEXT entry...
         $sval = substr($sval,length($tag));
         $sval = substr($sval,1) while ($sval =~ /^\s/);
         $tmp = get_next_non_space($sval);
         $tag = $tmp if length($tmp);
      }
      $tag =~ s/^\.libs\///;  # strip any '.libs/' off the nose
   } else {
      prtw("WARNING: $lnn: '-o' NOT found in [$val]\n");
   }
   return $tag;
}
sub show_gcc_output($$) {
   my ($rcmds,$rlines) = @_;
   my ($cnt,$i,$ind,$val,$key,$line,$out,$fnd,$ocnt,$others);
   my ($key2,$ind2,$val2,$kcnt);
   my ($keyo,$msg);
   my ($keym,$ind3,$done);
   $cnt = scalar @{$rlines};
   $key = 'gcc';
   $key2 = 'creating';
   $keym = 'make';
   prt( "\nGCC outputs (-o), and other items...\n" );
   $fnd = 0;
   $ocnt = 0;
   $others = '';
   my %created = ();
   my %objhash = ();
   for ($i = 0; $i < $cnt; $i++) {
      $line = ${$rlines}[$i];
      chomp $line;
      $ind = index($line, $key);
      $ind2 = index($line, $key2);
      $ind3 = index($line, $keym);
      $done = 0;
      if ( ($ind >= 0) && ($ind < length($key)) ) {
         $val = substr($line,length($key)+$ind);   # get after the command
         $out = get_gcc_out($val,$i+1);
         if (length($out) ) {
            if ($out =~ /\.o$/) {
               prt( " $out\n" );
               if ( ! defined $objhash{$out} ) {
                  $ocnt++;
                  $objhash{$out} = 1;
               }
            } elsif ($out =~ /^lib.+/) {
               prt( " $out\n" );
               if ( ! defined $objhash{$out} ) {
                  $ocnt++;
                  $objhash{$out} = 1;
               }
            } else {
               $others .= ' ' if length($others);
               $others .= $out;
            }
         } else {
            prtw( "WARNING: Did NOT find the -o output object! line=[$line]\n" );
         }
         $fnd++;
         $done = 1;
      }
      # if we have a 'creating'... probably following an 'ar' command,
      # but should be AFTER some gcc command to make the objects...
      if ( ($ind2 >= 0) && ($ind2 < length($key2)) ) {
         $val2 = substr($line,length($key2)+$ind2);
         prt( "$key2 : $val2 " );
         $kcnt = scalar keys(%objhash);
         my @arr;
         if ($kcnt) {
            $msg = '';
            foreach $keyo (keys %objhash) {
               $msg .= ' ' if length($msg);
               $msg .= $keyo;
               push(@arr,$keyo);
            }
            prt( "$kcnt=[$msg]" );
         }
         prt("\n");
         if (defined $created{$val2}) {
            my $ra = $created{$val2};
            push(@{$ra}, @arr);
            $created{$val2} = $ra;
         } else {
            $created{$val2} = [ @arr ];
         }
         %objhash = (); # clear the hash
         $done = 1;
      }
      if (!$done) {
         if ( ($ind3 >= 0) && ($ind3 < length($keym)) ) {
            prt("\n") if ($line =~ /Entering\s+directory/);
            prt( "$line\n" );
            $done = 1;
         }
      }
   }
   if ($fnd) {
      prt( "Found $fnd gcc outputs, $ocnt different objects (.o)...\n" );
      prtw( "WARNING: Other outputs: $others\n" ) if length($others);
   } else {
      prtw( "WARNING:1: NOT FOUND [$key]\n" );
   }
   return \%created;
}
sub show_cmd_example($$) {
   my ($rcmds,$rlines) = @_;
   my ($cnt,$i,$ind,$val,$key,$line,$min,$len);
   $cnt = scalar @{$rlines};
   $min = 0;
   foreach $key (sort keys %{$rcmds}) {
      $len = length($key);
      $min = $len if ($len > $min);
   }
   $min = $max_max if ($min > $max_max);
   foreach $key (sort keys %{$rcmds}) {
      if ( !(defined $cmds_of_interest{$key}) ) {
         for ($i = 0; $i < $cnt; $i++) {
            $line = ${$rlines}[$i];
            chomp $line;
            $ind = index($line, $key);
            if (($ind >= 0)&&($ind < length($key))) {
               $val = substr($line,length($key)+$ind);
               $key .= ' ' while (length($key) < $min);
               prt( "$key = $val\n" );
               last;
            }      
         }
         if ($i == $cnt) {
            prtw( "WARNING:2: NOT FOUND [$key]\n" );
         }
      }
   }
   foreach $key (sort keys %{$rcmds}) {
      if (defined $cmds_of_interest{$key}) {
         for ($i = 0; $i < $cnt; $i++) {
            $line = ${$rlines}[$i];
            chomp $line;
            $ind = index($line, $key);
            if (($ind >= 0)&&($ind < length($key))) {
               $val = substr($line,length($key)+$ind);
               $key .= ' ' while (length($key) < $min);
               prt( "$key = $val\n" );
               last;
            }      
         }
         if ($i == $cnt) {
            prtw( "WARNING:3: NOT FOUND [$key]\n" );
         }
      }
   }
}
sub trim_end_line($) {
   my ($ln) = shift;
   $ln = substr($ln,0,length($ln) - 1) while ($ln =~ /\s$/);
   return $ln;
}
sub get_a_line($$$) {
   my ($ri,$rlines,$lnc) = @_;
   my $i = ${$ri};
   my $ln = ${$rlines}[$i];
   chomp $ln;
   if ($use_trim_all) {
      $ln = trim_all($ln);
   } else {
      $ln = substr($ln,1) if ($ln =~ /^\s+/); # eat max 1 SPACE off front
      $ln = trim_end_line($ln);
   }
   return $ln;
}
sub get_next_line($$$) {
   my ($ri,$rlines,$lnc) = @_;
   my $i = ${$ri};
   my ($ln,$tmp,$tln,@arr);
   if (@extra_lines) {
       $i--;
       ${$ri} = $i; # back up, to keep the SAME line number
       $ln = shift @extra_lines;
       return $ln;
   }
   # else get a NEW line
   $ln = get_a_line($ri,$rlines,$lnc);
   $tmp = '';
   while ( ($ln =~ /\\$/) && (($i+1) < $lnc) ) {
      $i++;
      $ln =~ s/\\$//;
      $tmp = get_a_line(\$i,$rlines,$lnc);   # get next line
      last if (length($tmp) == 0);
      $ln .= ' ' if ( !($ln =~ /\s$/) && !($tmp =~ /^\s/) );
      $ln .= $tmp;
      ${$ri} = $i;
   }
   # 20090919 - maybe lines like
   # (cd .libs && rm -f lib_c.la && ln -s ../lib_c.la lib_c.la)
   # should be SPLIT, so decide to put the split into @extra_lines
    $tln = trim_all($ln);
    if (($tln =~ /^\(/) && ($tln =~ /\)$/)) {
        $tln = substr($tln,1,(length($tln) - 2)); # remove these brackets
        $tln = trim_all($tln);
        @arr = split( '&&', $tln );
        foreach $tmp (@arr) {
            $tmp = trim_all($tmp);
            push(@extra_lines,$tmp);
        }
        $ln = shift @extra_lines;
    }
   return $ln;
}   
sub path_to_space($$) {
    my ($ln, $rcmd ) = @_;
    my ($len,$c,$tag,$j);
    $len = length($ln);
    $tag = '';
    for ($j = 0; $j < $len; $j++) {
        $c = substr($ln,$j,1);
        if ($c =~ /\s/) {
            if (length($tag)) {
                ${$rcmd} = $tag;
                return 1;
            }
            last;
        } elsif ($c =~ /[\w:\\\/]/) {
            $tag .= $c;
        } else {
            return 0;
        }
    }
    return 0;
}
sub process_file($) {
   my ($fil) = @_;
   open INF, "<$fil" || die "ERROR: Unable to open [$fil]! aborted";
   my @lines = <INF>;
   my $lncnt = scalar @lines;
   prt("Doing $lncnt lines, from [$fil]...\n");
   my ($cmd,$cnt,$lnn,$errs,$i,$line,$ind);
   my %cmds = ();
   $lnn = 0;
   $errs = 0;
   my @nlines = ();
   my ($rh);
   for ($i = 0; $i < $lncnt; $i++) {
      $line = get_next_line(\$i,\@lines,$lncnt);
      push(@nlines,$line);
      $lnn = $i + 1;
      if ($line =~ /^(\w+)\s+/) {
         $cmd = $1;
         add_to_cmd_hash(\%cmds,$cmd) if (length($cmd));
      # } elsif ($line =~ /^make(.*)\s+/) {
      } elsif ($line =~ /^make\[(\d+)\]:\s+/) {
         $cmd = "make[".$1."]:";
         add_to_cmd_hash(\%cmds,$cmd) if (length($cmd));
      } elsif ($line =~ /^\*\*\*\s+/) {
         # these
      } elsif ($line =~ /^--\s+/) {
         # these
      } elsif ($line =~ /^WARNING:\s+/) {
         # ok
      } elsif ($line =~ /^\s+/) {
         # begins space
         if ($line =~ /^\s+gcc\s+/) {
            $cmd = "gcc";
            add_to_cmd_hash(\%cmds,$cmd) if (length($cmd));
         } else {
            prt( "Check spacey [$line]\n" );
         }
      } elsif (path_to_space( $line, \$cmd )) {
         add_to_cmd_hash(\%cmds,$cmd) if (length($cmd));
      } elsif ($line =~ /^\/bin\/bash\s+/) {
         $cmd = '/bin/bash';
         add_to_cmd_hash(\%cmds,$cmd) if (length($cmd));
      } elsif ($line =~ /^\/bin\/grep\s+/) {
         $cmd = '/bin/grep';
         add_to_cmd_hash(\%cmds,$cmd) if (length($cmd));
      } elsif ($line =~ /^(\/\w+)+\s+/) {
         $cmd = $1;
         $ind = index($line,' ');
         if ($ind > 0) {
            $cmd = substr($line,0,$ind-1);
         }
         add_to_cmd_hash(\%cmds,$cmd) if (length($cmd));
      } elsif ($line =~ /^\((\w+)\s+/) {
          # ok, it STARTS with a backet (, so may be a SET OF commands like
          # (cd =  .libs && rm -f lib_c.la && ln -s ../lib_c.la lib_c.la)
         $cmd = "(".$1;
         add_to_cmd_hash(\%cmds,$cmd) if (length($cmd));
      } elsif ($line =~ /^\.\/(\w+)\s+/) {
         $cmd = "./".$1;
         add_to_cmd_hash(\%cmds,$cmd) if (length($cmd));
      } elsif ($line =~ /^([\w:]+)\s+/) {
         $cmd = $1;
         add_to_cmd_hash(\%cmds,$cmd) if (length($cmd));
      } elsif ($line =~ /^=+$/) {
         # just '========='
      } elsif ($line =~ /^\d+%\s+/) {
         # a percentage
      } else {
         prt("$lnn: WHAT [$line]?\n");
         $errs++;
      }
   }
   $cnt = scalar keys(%cmds);
   prt( "Got $cnt commands...\n" );
   if ($errs) {
      prt("Fix if tumble to include the WHAT items\n");
   } else {
      show_cmd_example(\%cmds,\@nlines);
      $rh = show_gcc_output(\%cmds,\@nlines);
   }
   return $rh;
}
sub show_ref_hash($) {
   my ($rh) = @_;
   my $cnt = scalar keys(%{$rh});
   prt( "Got $cnt created items...\n" );
   my ($key,$val,$min,$len,$itm);
   $min = 0;
   foreach $key (keys %{$rh}) {
      $val = ${$rh}{$key};
      $len = length($key);
      $min = $len if ($len > $min);
   }
   foreach $key (sort keys %{$rh}) {
      $val = ${$rh}{$key};
      $key .= ' ' while (length($key) < $min);
      prt( "$key : " );
      foreach $itm (@{$val}) {
         prt( "$itm " );
      }
      prt("\n");
   }
}
##########################################################################
###### MAIN
if (@ARGV) {
   $in_file = $ARGV[0];
   prt( "Set in file to [$in_file]\n");
}
my $ref_hash = process_file($in_file);
show_ref_hash($ref_hash);
show_warnings();
close_log($outfile,$load_log);
exit(0);
# eof

index -|- top