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; }