Generated: Tue Feb 2 17:54:27 2010 from cmpvcprojs.pl 2008/08/16 16.8 KB.
#!/perl -w # NAME: cmpvcprojs.pl # AIM: To compare two VCPROJ files, and list - # (a) the different source, either added or deleted, and # (b) the differenct libraries, for both Debug and Release ... # This implementation was based on the code from vcprojlist.pl, and sln2dsw.pl # If given SOLUTION file (*.SLN), then each prject contained, will be compared. # 07/03/2008 - geoff mclane - http://geoffair.net/mperl/samples use strict; use warnings; use File::Basename; require 'logfile.pl' or die "Unable to load logfile.pl ...\n"; require 'relative.pl' or die "Unable to load relative.pl ...\n"; # log file stuff my ($LF); my $pgmname = $0; if ($pgmname =~ /\w{1}:\\.*/) { my @tmpsp = split(/\\/,$pgmname); $pgmname = $tmpsp[-1]; } my $outfile = "temp.$pgmname.txt"; open_log($outfile); prt( "$0 ... Hello, World ... at ". scalar localtime(time())."\n" ); my $in_file1 = 'C:\DTEMP\temp\Win32\libtar.vcproj'; my $in_file2 = 'C:\Projects\tar\Win32\libtar.vcproj'; #my $in_file1 = 'C:\FG\18\fgfs\fgfs.sln'; #my $in_file2 = 'C:\FG\19\fgfs\fgfs.sln'; my $v8_cfgexp = '<Configuration\\s+.*Name=\\"(\\S+)\\"\\s'; my %sln_projects1 = (); # projects FOUND in SLN file - key=name, data=vcproj file my %sln_projpath1 = (); # and the RELATIVE path of the project, IF ANY ... my %sln_projects2 = (); # projects FOUND in SLN file - key=name, data=vcproj file my %sln_projpath2 = (); # and the RELATIVE path of the project, IF ANY ... # degug my $dbg_sl1 = 0; my $dbg1 = 0; # show all the files, and their directory my $dbg2 = 0; my $dbg2a = 0; my $dgb3 = 0; my $dbg_src6 = 0; my $dbg_src7 = 0; my $dbg_src12 = 0; my $dbg_src12a = 0; my $dbg_src13 = 0; my @warnings = (); my @deleted = (); my @added = (); # work items my %sln_projects = (); # projects FOUND in SLN file - key=name, data=vcproj file my %sln_projpath = (); # and the RELATIVE path of the project, IF ANY ... my ($xnm,$xdir,$xext, $prj1, $val1, $val2); my @srclist = (); my %v8_depend = (); my $msg = ''; # DO FILE ONE %sln_projects = (); # clear entries %sln_projpath = (); if (is_solution($in_file1)) { process_SLN( $in_file1 ); } elsif (is_vcproj($in_file1)) { ($xnm,$xdir,$xext) = fileparse( $in_file1, qr/\.[^.]*/ ); $sln_projects{$xnm} = $in_file1; $sln_projpath{$xnm} = $xdir; } else { mydie("ERROR: $in_file1 is NOT solution (.SLN) nor project (.vcproj)!!!\n"); } %sln_projects1 = %sln_projects; # projects FOUND in SLN file - key=name, data=vcproj file %sln_projpath1 = %sln_projpath; # and the RELATIVE path of the project, IF ANY ... # DO FILE TWO %sln_projects = (); # clear entries %sln_projpath = (); process_SLN( $in_file2 ); if (is_solution($in_file2)) { process_SLN( $in_file2 ); } elsif (is_vcproj($in_file2)) { ($xnm,$xdir,$xext) = fileparse( $in_file2, qr/\.[^.]*/ ); $sln_projects{$xnm} = $in_file2; $sln_projpath{$xnm} = $xdir; } else { mydie("ERROR: $in_file1 is NOT solution (.SLN) nor project (.vcproj)!!!\n"); } %sln_projects2 = %sln_projects; # projects FOUND in SLN file - key=name, data=vcproj file %sln_projpath2 = %sln_projpath; # and the RELATIVE path of the project, IF ANY ... # DONE BOTH INPUT FILES if ($dbg2) { foreach $prj1 (keys %sln_projects1) { $val1 = $sln_projects1{$prj1}; if (defined $sln_projects2{$prj1}) { $val2 = $sln_projects2{$prj1}; } else { $val2 = "Does NOT exist"; } if (uc($val1) eq uc($val2)) { $val2 = "*** THE SAME FILE ***"; } prt("proj=$prj1 - cmp [$val1] with [$val2]\n"); } foreach $prj1 (keys %sln_projects2) { $val2 = $sln_projects2{$prj1}; if (defined $sln_projects1{$prj1}) { $val1 = $sln_projects1{$prj1}; } else { $val1 = "Does NOT exist"; prt("proj=$prj1 - cmp [$val1] with [$val2]\n"); } } } my ($nm,$dir, $ext); foreach $prj1 (keys %sln_projects1) { $val1 = $sln_projects1{$prj1}; if (defined $sln_projects2{$prj1}) { $val2 = $sln_projects2{$prj1}; @srclist = (); %v8_depend = (); $nm = $prj1; ##$dir = $sln_projpath1{$prj1}; my @xlines1 = load_xml_lines( $val1 ); process_xml_lines( $prj1, $dir, @xlines1 ); my @srclist1 = @srclist; my %v8_depend1 = %v8_depend; @srclist = (); %v8_depend = (); ##$dir = $sln_projpath2{$prj1}; my @xlines2 = load_xml_lines( $val2 ); process_xml_lines( $prj1, $dir, @xlines2 ); my @srclist2 = @srclist; my %v8_depend2 = %v8_depend; # NOW TO COMPARE SOURCE LIST 1 and 2 #################################### my $s1cnt = scalar @srclist1; my $s2cnt = scalar @srclist2; ### 0 1 2 3 4 ### push( @srclist, [$src, $ff, $rp, $dir, 0] ); my ($i, $j, $src1, $src2, $fnd1, $fnd2, $miss1, $miss2); for ($i = 0; $i < $s1cnt; $i++) { $src1 = $srclist1[$i][0]; $fnd1 = 0; for ($j = 0; $j < $s2cnt; $j++) { $src2 = $srclist2[$j][0]; if (uc($src1) eq uc($src2)) { $srclist1[$i][4] = $j + 1; $srclist2[$j][4] = $i + 1; $fnd1 = 1; last; } } } $miss1 = 0; $miss2 = 0; for ($i = 0; $i < $s1cnt; $i++) { $src1 = $srclist1[$i][0]; if ($srclist1[$i][4] == 0) { $msg = "$prj1 - $src1 NOT FOUND IN 2 ... DELETED"; push(@deleted, $msg); prt( "$msg\n" ); $miss1++; } } $miss2 = 0; for ($j = 0; $j < $s2cnt; $j++) { $src2 = $srclist2[$j][0]; if ($srclist2[$j][4] == 0) { $msg = "$prj1 - $src2 NOT FOUND IN 1 ... ADDED"; prt( "$msg\n" ); push(@added, $msg); $miss2++; } } if (($miss1 == 0)&&($miss2 == 0)) { prt( "$prj1 - Appears the SAME ...\n" ); } else { $msg = "$prj1 - Missed 1 = $miss1, Missed 2 = $miss2"; prt( "$msg ...\n" ); } ############################################ ####### NOW COMPARE THE LIBRARY LISTS ###### # %v8_depend1 and %v8_depend2 - Key is CONFIG (Release or Debug) # and value is the LIBRARY LIST foreach my $ky (keys %v8_depend1) { my $val1 = $v8_depend1{$ky}; prt( "For configuration [$ky] ... library list ...\n" ); my @liblist1 = split(/\s/,$val1); foreach my $itm (sort @liblist1) { prt( "$itm\n" ); } if (defined $v8_depend2{$ky}) { my $val2 = $v8_depend2{$ky}; my @liblist2 = split(/\s/,$val2); $s1cnt = scalar @liblist1; $s2cnt = scalar @liblist2; for ($i = 0; $i < $s1cnt; $i++) { $val1 = $liblist1[$i]; for ($j = 0; $j < $s2cnt; $j++) { $val2 = $liblist2[$j]; if (uc($val1) eq uc($val2)) { $liblist1[$i] = ''; $liblist2[$j] = ''; last; } } } for ($i = 0; $i < $s1cnt; $i++) { $val1 = $liblist1[$i]; if (length($val1)) { $msg = "$prj1 - $ky=$val1 NOT FOUND IN 2 ... DELETED LIBRARY"; push(@deleted, $msg); prt( "$msg\n" ); } } for ($j = 0; $j < $s2cnt; $j++) { $val2 = $liblist2[$j]; if (length($val2)) { $msg = "$prj1 - $ky=$val2 NOT FOUND IN 1 ... ADDED LIBRARY"; push(@added, $msg); prt( "$msg\n" ); } } } else { prtw( "$prj1 - KEY $ky NOT FOUND IN v8_depend2!" ); } } ############################################ } else { $val2 = "Does NOT exist"; prt("proj=$prj1 - cmp [$val1] with [$val2]\n"); } } prt( "\nIn comparing 1[$in_file1], with 2[$in_file2] ...\n" ); if (@deleted) { prt( "Appears ".scalar @deleted." DELETED items ...\n" ); foreach $msg (@deleted) { prt( "$msg\n" ); } } if (@added) { prt( "Appears ".scalar @added." ADDED items ...\n" ); foreach $msg (@added) { prt( "$msg\n" ); } } if (!@deleted && !@added) { prt( "Appears they have the SAME source list ...\n" ); } show_warnings(); prt("\n"); close_log($outfile,1); exit(0); ############################################################# ### sub only below 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; } # 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 process_xml_lines { my ($aproj, $adir, @xlines) = @_; my $xlncnt = scalar @xlines; prt( "$aproj ($adir) ... processing $xlncnt XML lines ...\n" ); # looking for '<File RelativePath="..\..\src\osg\ApplicationUsage.cpp" >' my $conf = ''; my $adddeps = ''; foreach my $fline (@xlines) { if ($fline =~ /$v8_cfgexp/ ) { ##if ($fline =~ /<Configuration\s+.*Name=\"(\S+)\"\s/ ) { $conf = $1; prt( "Got configuration $conf\n" ) if ($dbg_src6); } elsif ($fline =~ /^<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] $dir\n" ) if ($dbg1); $src =~ s/^\.[\/\\]// if (length($src) > 2); # remove any '.\' from the file name push( @srclist, [$src, $ff, $rp, $dir, 0] ); } elsif ($fline =~ /<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 ...[$fline]\n" ) if ($dbg_src7); my @attribs = space_split($fline); my %atthash = array_2_hash_on_equals(@attribs); if ($dbg_src12a) { # DEBUG ONLY prt( "Split of attribs [$fline] ...\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 is_vcproj { my $fil = shift; if ($fil =~ /\.vcproj$/i) { return 1; } return 0; } sub is_solution { my $fil = shift; if ($fil =~ /\.sln$/i) { return 1; } return 0; } sub strip_quotes { my ($ln) = shift; if ($ln =~ /^".*"$/) { $ln = substr($ln,1,length($ln)-2); } return $ln; } sub fix_rel_path { my ($path) = shift; $path = path_u2d($path); # ENSURE DOS PATH SEPARATOR (in relative.pl) 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 { prtw( "WARNING: Got relative .. without previous!!! path=$path\n" ); } } else { push(@na,$p); } } foreach my $pt (@na) { $npath .= "\\" if length($npath); $npath .= $pt; } return $npath; } sub process_SLN { my ($fil) = shift; my ($cnt, $line, $vers, @arr, $mver, $par, $ff, $itmnum); my ($projname, $projfile, $projff, $gotproj, $relpath); my ($tnm,$tpth); open IF, "<$fil" or mydie( "ERROR: Unable to open $fil ... $! ...\n" ); my @lines = <IF>; close IF; $cnt = scalar @lines; my ($name,$sln_path) = fileparse($fil); prt( "\nProcessing $cnt lines ... n=[$name] p=[$sln_path] ...\n" ); $projname = ''; $projfile = ''; $projff = ''; $gotproj = 0; foreach $line (@lines) { if ($line =~ /.+Format\s+Version\s+(\d+\.\d+)$/i) { $vers = $1; # get n.nn version @arr = split(/\./,$vers); $mver = $arr[0]; prt( "Is MSVC Version $mver ...\n" ); } elsif ($line =~ /^Project\s*\(/) { ###prt( "Got project [$line] ...\n" ); @arr = split( '=', $line ); $cnt = scalar @arr; if ($cnt == 2) { $par = $arr[1]; @arr = split(',', $par); $cnt = scalar @arr; if ($cnt == 3) { $projname = strip_quotes(trim_all($arr[0])); $projfile = strip_quotes(trim_all($arr[1])); $projff = fix_rel_path($sln_path.$projfile); if ((length($projname)) && (is_vcproj($projfile)) && (-f $projff)) { $gotproj = 1; ($tnm,$tpth) = fileparse($projff); $relpath = get_rel_dos_path($tpth, $sln_path); prt( "Got PROJECT name=$projname, file=$projff, rel=[$relpath].\n" ) if ($dbg_sl1); ###push(@proj_files, $projff); if (defined $sln_projects{$projname} && (uc($projff) ne uc($sln_projects{$projname}) )) { prt( "Attempting to add [$projname] ... ff=[$projff]\n" ); prt( "But found ... ff=[".$sln_projects{$projname}."] already!!!\n" ); mydie( "A PROBLEM: Already GOT this project name $projname!!!\n" ); } else { $sln_projects{$projname} = $projff; $sln_projpath{$projname} = $relpath; # can be BLANK, or say 'BvMath/' } } } } if (!$gotproj) { @arr = split( /\"/, $line ); $itmnum = 0; foreach $par (@arr) { $itmnum++; ###prt( "$itmnum [$par]\n" ); if (is_vcproj($par)) { $ff = $sln_path.$par; prt( "Got PROJECT file [$par] " ); if ( -f $ff) { prt( "ok" ); ###push(@proj_files, $ff); my ($nm,$pt,$ex) = fileparse( $ff, qr/\.[^.]*/ ); $projname = $nm; ($tnm,$tpth) = fileparse($ff); $relpath = get_rel_dos_path($tpth, $sln_path); if (defined $sln_projects{$projname}) { prt( "Attempting to add [$projname] ... ff=[$ff]\n" ); prt( "But found ... ff=[".$sln_projects{$projname}."] already!!!\n" ); mydie( "A PROBLEM: Already GOT this project name $projname!!!\n" ); } else { $sln_projects{$projname} = $ff; $sln_projpath{$projname} = $relpath; # can be BLANK, or say 'BvMath/' } } else { prt( "FAILED" ); } prt("\n"); } } } } } ###prt( "Done $fil ... got ".scalar @proj_files." project files ...\n" ); prt( "Done $fil ... got ".scalar keys(%sln_projects)." project files ...\n" ); } sub load_xml_lines { my ($inf) = shift; my @xlines = (); my ($line); if ( !open INF, "<$inf" ) { prtw( "WARNING: Failed to open [$inf] ... $! ... \n" ); return @xlines; } my @lines = <INF>; close INF; my $lncnt = scalar @lines; ($nm,$dir,$ext) = fileparse( $inf, qr/\.[^.]*/ ); prt( "Processing $lncnt lines from [$nm$ext] path=[$dir]...\n" ) if ($dbg2 || $dbg2a); my $xml = ''; 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; prt("Returning $xlncnt lines ...\n" ) if ($dbg2); return @xlines; } sub prtw { my ($wmsg) = shift; prt($wmsg); push(@warnings,$wmsg); } sub show_warnings { if (@warnings) { prt( "WARNING: Got ".scalar @warnings." warnings messages ...\n" ); foreach my $wm (@warnings) { prt($wm); } } else { prt( "No warning or error messages ...\n" ); } } # eof - cmpvcprojs.pl