showsrcs.pl to HTML.

index -|- end

Generated: Tue Feb 2 17:54:55 2010 from showsrcs.pl 2005/12/07 6.4 KB.

#!/Perl
# AIM: Find and display SOURCES from Makefile.am in a FOLDER ...
print "Hello, World... running $0 ...\n";
my $dir = shift || die "ERROR: Must give an input direcory, folder ...\n";
print "Checking folder: $dir ...\n";
my ($ch, $i, $len, $is, $part);
my @dirs = ();
my $line;
$len = length($dir);
$is = 0;
for ($i = 0; $i < $len ; $i++) {
   $ch = substr($dir,$i,1);
   if (($ch eq '/') || ($ch eq '\\')) {
      # got a folder
      $part = substr($dir, $is, $i - $is);
      if (substr($part,0,1) eq $ch) {
         $part = substr($part,1);
      }
      push(@dirs, $part);
      $is = $i;
   }
}
if ($i > $is) {
   $part = substr($dir, $is, $i - $is);
   $ch = substr($part,0,1);
   if (($ch eq '/')||($ch eq '\\')) {
      $part = substr($part,1);
   }
   push(@dirs, $part);
}
my $dircnt = scalar @dirs;
my $file = $dir . '/Makefile.am';
if (! -f $file) {
   print "WARNING: No find of 'Makefile.am' in $dir ...\n";
   exit(1);
}
print "Found $file ... \n";
open FH, $file;
my @lines = <FH>;
close FH;
print "Makefile.am has " . scalar @lines . " lines ...\n";
my @srcs = ();
my $insrc = 0;
my @arr;
my $insub = 0;
my @subs = ();
my $pos = 0;
foreach $line (@lines) {
   chomp $line;
   while (( substr($line,0,1) eq ' ' )||( substr($line,0,1) eq "\t")) {
      $line = substr($line,1);
   }
   if ($insrc) {
      if ($line =~ /\\$/) {
         $line = substr($line, 0, length($line) - 1);
         $insrc = 1;
      } else {
         $insrc = 0;
      }
      @arr = split ' ', $line;
      push(@srcs,@arr);
      # if (! $insrc) {
      #   last;
2      #}
   } elsif ($line =~ /(.*)_SOURCES/) {
      $pos = index ($line, '='); # get position of equal sign
      if ($pos > 0) {
         $line = substr($line, ($pos+1)); # get balance of line, after '='
         if ($line =~ /\\$/) {
            $line = substr($line, 0, length($line) - 1);
            $insrc = 1;
         }
         @arr = split ' ', $line;
         push(@srcs,@arr);
      }
   } elsif ($line =~ /^SUBDIRS/) {
      $pos = index ($line, '='); # get position of equal sign
      if ($pos > 0) {
         $line = substr($line, ($pos+1)); # get balance of line, after '='
         if ($line =~ /\\$/) {
            $line = substr($line, 0, length($line) - 1);
            $insub = 1;
         }
         @arr = split ' ', $line;
         push(@subs,@arr);
      }
   } elsif ($insub) {
      if ($line =~ /\\$/) {
         $line = substr($line, 0, length($line) - 1);
         $insub = 1;
      } else {
         $insub = 0;
      }
      @arr = split ' ', $line;
      push(@subs,@arr);
   }
}
my $subcnt = scalar @subs;
print "Got " . scalar @srcs . " source files ...and subs=$subcnt ...\n";
my @scrsc = ();
foreach $line (@srcs) {
   chomp $line;
   if (($line =~ /\.cxx$/i) || ($line =~ /\.c$/i) || ($line =~ /\.cpp$/i)) {
      ### print "add $line to scrsc ...\n";
      push(@scrsc,$line);
   } else {
      if ( !(($line =~ /\.hxx$/i) || ($line =~ /\.h$/i) || ($line =~ /\.hpp$/i)) ) {
         print "CHECK Discarded source $line\n";
      }
   }
}
if ($subcnt) {
   # process lower 'Makefile.am' below this start folder
}
my $srccnt = scalar @scrsc;
print "Got $srccnt c/cxx/cpp source files ...\n";
if (! $srccnt) {
   print "Warning: Got NO source files ...\n";
   exit(2);
}
# have the SET of source files from the Makefile.am
# find the *.vcproj file ... maybe back up the path given
#my $dircnt = scalar @dirs;
my ($cd, $nf);
while ($dircnt) {
   $cd = get_nxt_dir( $dircnt );
   ###print "$cd\n";
   $nf = find_vcproj( $cd );
   if (length($nf)) {
      last;
   }
   $dircnt--;
}
$file = $cd . '/' . $nf;
if (! -f $file) {
   print "ERROR: Failed to find VCPROJ file ...\n";
   exit(4);
}
my $rdir = get_rel_dir($dircnt);
my $lrdir = length($rdir);
print "Processing $file ...\$dircnt=$dircnt ... rel.dir=$rdir\n";
open FH, $file;
@lines = <FH>;
close FH;
my $lncnt = scalar @lines;
print "Contain $lncnt line ...\n";
my @xmllines = ();
my @srclns = ();
my $aline = '';
foreach $line (@lines) {
   chomp $line;
   while (( substr($line,0,1) eq ' ' )||( substr($line,0,1) eq "\t")) {
      $line = substr($line,1);
   }
   if (length($aline)) {
      $aline .= ' ';
   }
   $aline .= $line;
   if ($aline =~ />$/) {
      push(@xmllines, $aline);
      if ($aline =~ /^<File /i) {
         $aline =~ s/^<File //;
         $aline =~ s/\">$//;
         $aline =~ s/^RelativePath=\"//i;
         $aline = dos_to_unix($aline);
         if (length($aline) > $lrdir) {
            my $sub1 = uc(substr($aline,0,$lrdir));
            my $sub2 = uc($rdir);
            ###print "Comparing $sub1 with $sub2 ...\n";
            if ( $sub1 eq $sub2 ) {
               my $pat = '^';
               $pat .= quotemeta($rdir);
               $aline =~ s/$pat//i;
               if (substr($aline,0,1) eq '/') {
                  $aline = substr($aline,1);
               }
               if (($aline =~ /\.cxx$/i) || ($aline =~ /\.c$/i) || ($aline =~ /\.cpp$/i)) {
                  push(@srclns, $aline);
               } else {
                  if ( !(($aline =~ /\.hxx$/i) || ($aline =~ /\.h$/i) || ($aline =~ /\.hpp$/i)) ) {
                     print "CHECK Discarded source $aline\n";
                  }
               }
            }
         }
      }
      $aline = '';
   }
}
my $xlncnt = scalar @xmllines;
my $scnt = scalar @srclns;
print "Got $xlncnt XML lines ... $scnt file source lines ...\n";
open FH, ">tempout.txt";
###foreach $line (@xmllines) {
my $gotln = 0;
print "Comparing " . scalar @srclns . " lines with " . scalar @scrsc . " lines ...\n";
foreach $line (@srclns) {
   $gotln = 0;
   foreach my $ln (@scrsc) {
      if ($line eq $ln) {
         $gotln = 1;
         last;
      }
   }
   if ($gotln) {
      print FH "Found $line\n";
   } else {
      print "DELETE $line\n";
      print FH "DELETE $line\n"
   }
}
print FH "And source AM lines ...\n";
$gotln = 0;
foreach $line (@scrsc) {
   $gotln = 0;
   foreach my $ln (@srclns) {
      if ($ln eq $line) {
         $gotln = 1;
         last;
      }
   }
   if ($gotln) {
      print FH "Found $line\n";
   } else {
      print "ADD $line\n";
      print FH "ADD $line\n";
   }
}
close FH;
sub find_vcproj {
   my ($d) = @_;
   ###print "Finding in $d ...\n";
   opendir DIR, $d;
   my @fils = readdir(DIR);
   closedir DIR;
   ###print "Found " . scalar @fils . " files and directories ...\n";
   foreach my $fil (@fils) {
      if ($fil =~ /(.*)\.vcproj$/i) {
         ###print "Found $fil ...\n";
         return $fil;
      }
   }
   return '';
}
sub get_nxt_dir {
   my ($p) = @_;
   my $nd = '';
   my $cnt = 0;
   foreach $line (@dirs) {
      ###print "$line ";
      if ($cnt) {
         $nd .= '/';
      }
      $nd .= $line;
      $cnt++;
      if ($cnt == $p) {
         last;
      }
   }
   return $nd;
}
sub get_rel_dir {
   my ($p) = @_;
   my $nd = '';
   my $cnt = 0;
   foreach $line (@dirs) {
      $cnt++;
      if ($cnt > $p) {
      ###print "$line ";
         if (length($nd)) {
            $nd .= '/';
         }
         $nd .= $line;
      }
   }
   return $nd;
}
sub dos_to_unix {
   my ($d) = @_;
   $d =~ s/\\/\//g;
   return $d;
}

index -|- top

checked by tidy  Valid HTML 4.01 Transitional