slnlist.pl to HTML.

index -|- end

Generated: Tue Feb 2 17:54:56 2010 from slnlist.pl 2007/09/05 8.2 KB.

#!/perl -w
# NAME: slnlist.pl
# AIM: Given a MSVC8 SLN file, show the LIST of VCPROJ files it references
# 04/09/2007 - add output of SOURCE files from vcproj files
# 26/04/2007 - geoff mclane - http://geoffmclane.com/mperl/samples/index.htm
use strict;
use warnings;
use File::Basename;
######################################################################################
require 'logfile.pl' or die "Unable to load logfile.pl ...\n";
# log file stuff
my ($LF);
my $outfile = 'temp.'.$0.'.txt';
if ($0 =~ /\w{1}:\\.*/) {
   my @tmpsp = split(/\\/,$0);
   $outfile = 'temp.'.($tmpsp[-1]).'.txt';
}
open_log($outfile);
prt( "$0 ... Hello, World ...\n" );
my $show_rel = 1;
my $fix_rela = 1;
my $show_srcs = 1;   # also OUTPUT the SOURCE files in the project files
my $recursive = 1;
my $dbg_on = 1;   # to run without a command line
my $base_dir = "C:\\FG\\FGCOM\\iaxclient\\";
my $def_input = $base_dir."contrib\\win\\vs2005\\iaxclient.sln";
##my $base_dir = "C:\\FG\\FGCOM\\xmlrpc-c\\";
##my $def_input = $base_dir."Windows\\xmlrpc.sln"; # adjust this to the file you want parsed
###my $base_dir = "C:\\FG\\14\\";
###my $def_input = $base_dir."fgfs\\fgfs.sln"; # adjust this to the file you want parsed
my $in_file = '';
my @file_list = ();
my $pcnt = 0;
my $line = '';
my ($fil_nm,$fil_dir,$fil_ext);
my @warnings = ();
my $wmsg = '';
my $cnt = 0;
my $srccnt = 0;
my @srcsc = ();   # list FROM vcproj files
my @dir_list = ();   # list from DIRECTORY search
my $dir_cnt = 0;
# debug items
my $dbg1 = 0;   # show missing as found ...
my $dbg3 = 0;
my @missing = ();
if ($dbg_on) {
   $in_file = $def_input;
}
if ((length($in_file) == 0) || !( -f $in_file )) {
   if (length($in_file)) {
      mydie( "ERROR: Can NOT locate [$in_file] ... $! ...\n" );
   } else {
      mydie( "ERROR: Must give a SLN input file ...\n" );
   }
}
($fil_nm,$fil_dir,$fil_ext) = fileparse( $in_file, qr/\.[^.]*/ );
if (lc($fil_ext) eq '.sln') {
   # push(@projs, [ $arr[0], $arr[1] ]);
   @file_list = process_sln( $in_file );
} else {
   mydie( "ERROR: Not a SOLUTION (.sln) file [$in_file] ...\n" );
}
$cnt = scalar @file_list;
prt( "Got $cnt files from $in_file ...\n" );
my $rp = substr($in_file, length($base_dir));
prt( "Begin List - first solution name, then VCPROJ files ...\n" );
prt( "$rp\n" );
###   push(@projs, [ $arr[0], $arr[1] ]);
for (my $i = 0; $i < $cnt; $i++) {
   $line = $file_list[$i][1];
   $line = fix_rel($fil_dir.$line);
   $rp = substr($line, length($base_dir));
   if ($show_rel) {
      prt( "$rp\n" );
   } else {
      prt( "$line\n" );
   }
}
prt( "End List of first solution name, then VCPROJ files ...\n" );
if ($show_srcs) {
   for (my $i = 0; $i < $cnt; $i++) {
      $line = $file_list[$i][1];
      $line = fix_rel($fil_dir.$line);
      $rp = substr($line, length($base_dir));
      if ($i == 0) {
         prt( "The SOLUTION FILE: " );
         if ($show_rel) {
            prt( "$rp\n" );
         } else {
            prt( "$line\n" );
         }
      } else {
         if (open(INF, "<$line")) {
            my @lns = <INF>;
            close INF;
            process_vcproj_xml_lines($line, @lns);
         } else {
            prt( "WARNING: FAILED TO OPEN [$line]! ... $! ...\n" );
         }
      }
   }
}
$dir_cnt = process_directory( $base_dir, 0 );
if ($srccnt) {
   my $ccnt = scalar @srcsc;
   prt( "Found $srccnt source files, $ccnt C/C++ sources, $dir_cnt from search ...\n" );
   # compare push(@srcsc, $asrc); from vcproj, and
   # push(@dir_list, $ff); from directory search
   for (my $i = 0; $i < $dir_cnt; $i++) {
      my $fil1 = $dir_list[$i];
      my $fnd = 0;
      for (my $j = 0; $j < $ccnt; $j++) {
         my $fil2 = $srcsc[$j];
         if ($fil1 eq $fil2) {
            $fnd = 1;
            last;
         }
      }
      if (!$fnd) {
         prt( "$fil1 NOT IN VCPROJ files???\n" );
      }
   }
}
if (@missing) {
   my $mcnt = scalar @missing;
   prt( "Got $mcnt MISSING, as follows ...\n" );
   my $cfil = '';
   my ($fil, $mis, $i);
   for ($i = 0; $i < $mcnt; $i++) {
      $fil = $missing[$i][0];
      $mis = $missing[$i][1];
      if ($fil ne $cfil) {
         prt( "Missing from $fil ...\n" );
         $cfil = $fil;
      }
      prt( "$mis - MISSING\n" ); 
   }
}
close_log($outfile,1);
exit(0);
sub process_vcproj_xml_lines {
   my ($fil, @lines) = @_;
   my $max = scalar @lines;
   my $rp = substr($fil, length($base_dir));
   my ($nm,$dir) = fileparse($fil);
   prt( "Got $max lines from $rp to process ...\n" );
   my $fline = '';
   my $fcnt = 0;
   for (my $i = 0; $i < $max; $i++) {
      my $line = $lines[$i];
      chomp $line;
      $line = trim_all($line);
      $fline .= ' ' if length($fline);
      $fline .= $line;
      if ($fline =~ />/) {
         $fline = trim_all($fline);
         my $src = '';
         my $asrc = '';
         my $msg = '';
         # check file name - include \w, which include _, ., \, and - - more?
         if ($fline =~ /<File\sRelativePath="{1}([\.\\\w-]+)"{1}\s*>/i) {
            $src = $1;
            $asrc = fix_rel($dir.$src);
            $msg = "MISSING!";
            $msg = "ok" if ( -f $asrc);
         } elsif ($fline =~ /<File\sRelativePath="{1}(.+)"{1}\s*>/i) {
            $src = $1;
            $asrc = fix_rel($dir.$src);
            $msg = "MISSING!";
            $msg = "ok" if ( -f $asrc);
            $msg .= " *** CHECK ME *** 2";
         }
         if (length($src)) {
            my ($nm2,$dir2,$ext2) = fileparse($src, qr/\.[^.]*/ ); 
            prt( "$asrc $msg $ext2\n" ) if ($dbg1);
            my $lcex = lc($ext2);
            if (($lcex eq '.c')||($lcex eq '.cpp')||($lcex eq '.cxx')) {
               push(@srcsc, $asrc);
            }
            $fcnt++;
            if ($msg =~ /^MISSING/) {
               push(@missing, [$fil, $asrc]);
            }
         }
         $fline = '';
      }
   }
   prt("Count $fcnt ...\n");
   $srccnt += $fcnt;
}
sub unix_2_dos {
   my ($f) = shift;
   $f =~ s/\//\\/g;
   return $f;
}
sub fix_rel {
   my ($path) = shift;
   $path = unix_2_dos($path);   # ensure DOS separator
   my @a = split(/\\/, $path);   # split on DOS separator
   my $npath = '';
   my $max = scalar @a;
   my @na = ();
   for (my $i = 0; $i < $max; $i++) {
      my $p = $a[$i];
      if ($p eq '.') {
         # ignore this
      } elsif ($p eq '..') {
         if (@na) {
            pop @na;   # discard previous
         } else {
            $wmsg = "WARNING: Got relative .. without previous!!! [$path]";
            prt( "$wmsg\n" );
            push(@warnings,$wmsg);
         }
      } else {
         push(@na,$p);
      }
   }
   foreach my $pt (@na) {
      $npath .= "\\" if length($npath);
      $npath .= $pt;
   }
   return $npath;
}
## } elsif (lc($fil_ext) eq 'sln') {
sub process_sln {
   my ($fil) = shift;
   my ($lc, $wmsg);
   prt( "Processing SLN file [$fil] ...\n" );
   if ( !open INF, "<$fil" ) {
      $wmsg = "WARNING: Unable to open [$fil] ...";
      prt( "$wmsg\n" );
      push(@warnings, $wmsg);
      return 0;
   }
   my @lines = <INF>;
   close INF;
   $lc = scalar @lines;
   prt( "Processing $lc lines ...\n" );
   my $cnt = 0;
   my @projs = ();
   foreach $line (@lines) {
      $line = trim_all($line);
      if ($line =~ /Project\(.*=(.*)/) {
         $cnt++;
         ##prt( "$1\n" );
         my @arr = split(/,/, $1);
         if (scalar @arr >= 2) {
            $arr[0] = trim_all($arr[0]);
            $arr[1] = trim_all($arr[1]);
            $arr[0] = substr($arr[0],1,length($arr[0])-2);
            $arr[1] = substr($arr[1],1,length($arr[1])-2);
            prt( "$cnt [".$arr[0]."] [".$arr[1]."] ...\n" );
            push(@projs, [ $arr[0], $arr[1] ]);
         }
      }
   }
   $cnt = scalar @projs;
   prt( "Done $lc lines ... $cnt projects ...\n" );
   ##for (my $i = 0; $i < $cnt; $i++) {
   ##   process_vcproj( fix_rel($fil_dir.$projs[$i][1]) );
   ##}
   return @projs;
}
sub is_my_file {
   my ($f) = shift;
   my ($nm,$dir,$ext) = fileparse( $f, qr/\.[^.]*/ );
   my $lext = lc($ext);
   if (($lext eq '.c')||($lext eq '.cpp')||($lext eq '.cxx')) {
      return 1;
   }
   return 0;
}
sub process_directory { ## $in_folder
   my ($inf, $lev) = @_;
   my $rcnt = 0;
   my ($DH);
   if ( !opendir($DH, $inf) ) {
      prt( "ERROR: Unable to OPEN FOLDER [$inf] ... $! ... \n" );
      return $rcnt;
   }
   my @files = readdir($DH);
   closedir $DH;
   my $fcnt = scalar @files;
   prt( "Have $fcnt to process from $inf ...\n" ) if ($dbg3);
   foreach my $file (@files) {
      if (($file eq '.') || ($file eq '..')) {
         next;
      }
      my $ff = $inf;
      $ff .= "\\" if !($ff =~ /\\$/);
      $ff .= $file;
      if ( -d $ff ) {
         if ($recursive) {
            ###if (!in_excl_list($file)) {
            $rcnt += process_directory( $ff, $lev + 1 );
         }
      } else {
         # is a FILE
         if ( is_my_file($file) ) {
            push(@dir_list, $ff);
            $rcnt++;
         }
      }
   }
   return $rcnt;
}
# eof - slnlist.pl

index -|- top

checked by tidy  Valid HTML 4.01 Transitional