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