vcprojlist.pl to HTML.

index -|- end

Generated: Tue Feb 2 17:55:00 2010 from vcprojlist.pl 2008/03/07 7.4 KB.

#!/perl -w
# NAME: vcprojlist.pl
# AIM: Parse a vcproj file, and list the sources is contains.
# 07/03/2008 - add show of LIBRARIES used for each configuration
# 15/05/2007 - geoff mclane - http://geoffmclane.com/mperl/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 $def_input =  'C:\FG\19\FlightGear\FlightGear.vcproj';
#my $def_input =  'C:\FG\15\OpenSceneGraph\VisualStudio\osg\osg.vcproj';
my $in_file = $def_input;
my $showsrcs = 1;   ## list sources at end
my $showlibs = 1;   ## list libraries used, at end
my $dbg1 = 0;   # show as found ...
my $dbg_src6 = 0;   # show "Got configuration $conf ...
my $dbg_src7 = 0;   # show "Is linker tool ...[$fline]\n"
my $dbg_src12 = 0;   # DEBUG ONLY
my $dbg_src12a = 0;   # DEBUG ONLY
my $dbg_src13 = 0;
my $v8_cfgexp = '<Configuration\\s+.*Name=\\"(\\S+)\\"\\s';
my %v8_depend = ();   # linker addtional dependencies, by configuration
my @srclist = ();
my ($line, $i);
my $adddeps = '';
if ( !open INF, "<$in_file" ) {
   mydie( "ERROR: Failed to open [$in_file] ... $! ... \n" );
}
my @lines = <INF>;
close INF;
my $lncnt = scalar @lines;
my ($nm,$dir,$ext) = fileparse( $in_file, qr/\.[^.]*/ );
prt( "Processing $lncnt lines from [$nm$ext] path=[$dir]...\n" );
my $xml = '';
my @xlines = ();
my $inx = 0;
foreach $line (@lines) {
   $line = trim_all($line);
   my $len = length($line);
   $xml .= ' ' if ($len && length($xml));
   for (my $i = 0; $i < $len; $i++) {
      my $ch = substr($line,$i,1);
      if ($inx) {
         if ($ch eq '>') {
            $xml .= $ch;
            push(@xlines, trim_all($xml));
            $inx = 0;
            $xml = '';
            $ch = '';
         }
      } else {
         if ($ch eq '<') {
            if (length($xml)) {
               push(@xlines, trim_all($xml));
            }
            $xml = '';
            $inx = 1;
         }
      }
      $xml .= $ch;
   }
}
$xml = trim_all($xml);
push(@xlines, $xml) if (length($xml));
my $xlncnt = scalar @xlines;
process_xml_lines();
###my $xline = join("\n", @xlines);
###write2file( $xline, "temp1.xml" );
my $scnt = scalar @srclist;
prt( "Got $scnt sources ... relative to [$dir] ...\n" );
if ($showsrcs) {
   for ($i = 0; $i < $scnt; $i++) {
      my $src = $srclist[$i];
      if ( is_cpp_src($src) ) {
         prt( "$src\n" );
      }
   }
}
if ($showlibs) {
   foreach my $ky (keys %v8_depend) {
      my $val = $v8_depend{$ky};
      prt( "For configuration [$ky] ... library list ...\n" );
      my @liblist = split(/\s/,$val);
      foreach my $itm  (sort @liblist) {
         prt( "$itm\n" );
      }
   }
}
close_log($outfile,1);
exit(0);
#####################################################################################
sub process_xml_lines {
   prt( "Processing $xlncnt XML lines ...\n" );
   # looking for '<File RelativePath="..\..\src\osg\ApplicationUsage.cpp" >'
   my $conf = '';
   foreach $line (@xlines) {
      my $fline = $line;
      if ($fline =~ /$v8_cfgexp/ ) {
         ##if ($fline =~ /<Configuration\s+.*Name=\"(\S+)\"\s/ ) {
         $conf = $1;
         prt( "Got configuration $conf\n" ) if ($dbg_src6);
      } elsif ($line =~ /^<File\s+RelativePath=(.*)>/) {
         my $src = $1;
         $src =~ s/"//g;
         while ($src =~ /\s$/) {
            $src = substr($src,0, length($src) - 1); # remove all TRAILING space
         }
         $src = unix_2_dos($src);
         my $ff = $dir;
         if (substr($src,0,1) eq "\\") {
            $src = substr($src,1);
         }
         $ff .= $src;
         $ff = fix_rel_path($ff);
         my $rp = get_rel_path( $dir, $ff );
         prt( "$ff ($src) [$rp]\n" ) if ($dbg1);
         ##push( @srclist, [$rp, $ff, $dir, $src] );
         $src =~ s/^\.[\/\\]// if (length($src) > 2);   # remove any '.\' from the file name
         push( @srclist, $src );
      } elsif ($line =~ /<Tool\s+(.*)$/ ) {
         my $pline = $1;
         #prt( "Got Tool $pline\n" ) if ($dbg_src7);
         if ($pline =~ /\s*Name=\"*(\w+)\"*/) {
            my $tname = $1;
            ###prt( "$tname\n" );
            if ($tname eq 'VCLinkerTool') {
               # <Tool
               # Name="VCLinkerTool"
               # AdditionalDependencies="comctl32.lib Msimg32.lib Winmm.lib"
               # LinkIncremental="1"
               # GenerateDebugInformation="true"
               # SubSystem="2"
               # OptimizeReferences="2"
               # EnableCOMDATFolding="2"
               # TargetMachine="1"
               # />
               prt( "Is linker tool ...[$line]\n" ) if ($dbg_src7);
               my @attribs = space_split($line);
               my %atthash = array_2_hash_on_equals(@attribs);
               if ($dbg_src12a) {   # DEBUG ONLY
                  prt( "Split of attribs [$line] ...\n" );
                  foreach $adddeps (@attribs) {
                     prt( " $adddeps\n" );
                  }
                  prt( "Show of HASH ...\n" );
                  foreach $adddeps (keys %atthash) {
                     prt( " $adddeps = ".$atthash{$adddeps}."\n" );
                  }
               }
               if (defined $atthash{'AdditionalDependencies'} ) {
                  $adddeps = strip_quotes(trim_all($atthash{'AdditionalDependencies'}));
                  prt( "Setting ADDS: $conf [$adddeps]\n" ) if ($dbg_src12);
                  $v8_depend{$conf} = $adddeps;
               }
            }
         }
      }
   }
}
sub strip_quotes {
   my ($ln) = shift;
   if ($ln =~ /^".*"$/) {
      $ln = substr($ln,1,length($ln)-2);
   }
   return $ln;
}
# split_space - space_split - like split(/\s/,$txt), but honour double inverted commas
sub space_split {
   my ($txt) = shift;
   my $len = length($txt);
   my ($k, $ch, $tag, $incomm);
   my @arr = ();
   $tag = '';
   $incomm = 0;
   for ($k = 0; $k < $len; $k++) {
      $ch = substr($txt,$k,1);
      if ($incomm) {
         $incomm = 0 if ($ch eq '"');
         $tag .= $ch;
      } elsif ($ch =~ /\s/) {
         push(@arr, $tag) if (length($tag));
         $tag = '';
      } else {
         $tag .= $ch;
         $incomm = 1 if ($ch eq '"');
      }
   }
   push(@arr, $tag) if (length($tag));
   if ($dbg_src13) {
      prt( "space_split (".scalar @arr.") of [$txt]\n" );
      foreach $tag (@arr) {
         prt( " $tag\n" );
      }
   }
   return @arr;
}
sub array_2_hash_on_equals {
   my (@inarr) = @_;
   my %hash = ();
   my ($itm, @arr, $key, $val, $al, $a);
   foreach $itm (@inarr) {
      @arr = split('=',$itm);
      $al = scalar @arr;
      $key = $arr[0];
      $val = '';
      for ($a = 1; $a < $al; $a++) {
         $val .= '=' if length($val);
         $val .= $arr[$a];
      }
      if (defined $hash{$key}) {
         prt( "WARNING: Duplicate KEY: $key ...\n" );
         $hash{$key} .= "@".$val;
      } else {
         $hash{$key} = $val;
      }
   }
   return %hash;
}
sub is_cpp_src {
   my ($fil) = shift;
   my ($n, $d, $e) = fileparse( $fil, qr/\.[^.]*/ );
   if (lc($e) eq '.cpp') {
      return 1;
   } elsif (lc($e) eq '.c') {
      return 2;
   } elsif (lc($e) eq '.cxx') {
      return 3;
   }
   return 0;
}
sub unix_2_dos {
   my ($f) = shift;
   $f =~ s/\//\\/g;
   return $f;
}
sub get_rel_path {
   my ($path, $src) = @_;
   my @a1 = split(/\\/, $path);
   my @a2 = split(/\\/, $src);
   while ( @a1 && @a2 && ($a1[0] eq $a2[0])) {
      shift @a1;
      shift @a2;
   }
   my $np = join("\\", @a2);
   while (@a1) {
      $np = "..\\".$np;
      pop @a1;
   }
   return $np;
}
sub fix_rel_path {
   my ($path) = shift;
   my @a = split(/\\/, $path);
   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 {
            prt( "WARNING: Got relative .. without previous!!!\n" );
         }
      } else {
         push(@na,$p);
      }
   }
   foreach my $pt (@na) {
      $npath .= "\\" if length($npath);
      $npath .= $pt;
   }
   return $npath;
}
# eof

index -|- top

checked by tidy  Valid HTML 4.01 Transitional