Generated: Tue Feb 2 17:54:59 2010 from vc8cmp-01.pl 2006/06/11 11.1 KB.
#!/Perl # use strict; use Cwd; use Win32::OLE qw(in with); my $vers = "0.0.1"; my $cwdir = getcwd(); my $in_file1 = "c:\\fgcvs\\flightgear\\source\\projects\\vc8\\flightgear.sln"; my $in_file2 = "c:\\FG0910-3\\flightgear\\projects\\vc8\\flightgear.sln"; ##my $in_file2 = "c:\\FG0910-2\\flightgear\\source\\projects\\vc8\\flightgear.sln"; ### none = my $in_file2 = "c:\\FG0910\\flightgear\\source\\projects\\vc8\\flightgear.sln"; my @file1 = (); my @file2 = (); my $f1sln = 0; my $f2sln = 0; my ($IF1, $IF2); my ($LOG); my $write_log = 0; my $outfile = 'templog'.$vers.'.txt'; my @proj1 = (); my @proj2 = (); my $line = ""; my $pcnt1 = 0; my $pcnt2 = 0; my $fil1 = ""; my $fil2 = ""; my @pairs = (); my $pcnt = 0; if ( open( $LOG, ">$outfile" ) ) { $write_log = 1; } else { $write_log = 0; prt( "WARNING: Unable to open $outfile LOG ...\n" ); } my @src_list1 = (); my @src_list2 = (); my @ssrc_list1 = (); my @ssrc_list2 = (); my ($scnt1, $scnt2); my $node_name = '//Files/Filter/File'; my $att_name = 'RelativePath'; my $dom1 = Win32::OLE->new('MSXML2.DOMDocument.3.0') or die "new() failed"; my $dom2 = Win32::OLE->new('MSXML2.DOMDocument.3.0') or die "new() failed"; $dom1->{async} = "False"; $dom1->{validateOnParse} = "False"; $dom2->{async} = "False"; $dom2->{validateOnParse} = "False"; parse_arguments(@ARGV); check_input(); get_vcproj_files(); # try to find vcproj files $pcnt1 = scalar @proj1; $pcnt2 = scalar @proj2; prt( "Got $pcnt1 vcproj files from file 1 ...\n" ); prt( "Got $pcnt2 vcproj files from file 2 ...\n" ); check_match(); $pcnt = ( scalar @pairs ) / 2; prt("Got $pcnt pairs of vcproj files...\n"); for (my $i = 0; $i < $pcnt ; $i++) { $fil1 = $pairs[ ($i * 2) ]; $fil2 = $pairs[ ($i * 2) + 1 ]; compare_files( $fil1, $fil2 ); } $scnt1 = scalar @src_list1; $scnt2 = scalar @src_list2; prt("File 1 has $scnt1, and 2 has $scnt2 source files ...\n"); @ssrc_list1 = sort( @src_list1 ); @ssrc_list2 = sort( @src_list2 ); my $cnt = $scnt1; if ($scnt2 > $scnt1) { $cnt = $scnt2; } my ($i, $j); prt("Comparing sorted lists $cnt files...\n"); for ($i = 0; $i < $cnt; $i++) { $fil1 = lc($ssrc_list1[$i]); if ($j < $scnt2) { $fil2 = lc($ssrc_list2[$j]); $j++; if ($fil1 ne $fil2) { prt( "Different [$fil1] vs [$fil2] ...\n" ); } } else { prt( "No match for $fil1 ...\n" ); } } prt("Done $i file compares ...\n" ); exit 0; ##################################################### sub compare_files { my ($f1, $f2) = @_; my $at; prt("Comparing [$f1] with [$f2] ...\n" ); $dom1->Load($f1) or die "Parse failed"; $dom2->Load($f2) or die "Parse failed"; my $node_list1 = $dom1->selectNodes($node_name); my $ncnt1 = keys( %$node_list1 ); prt( "Got $ncnt1 nodes of $node_name ...\n" ); foreach my $node1 (in $node_list1) { $at = $node1->getAttribute($att_name); if (length($at) > 0) { prt("Got [$att_name=\"$at\"] ...\n"); push(@src_list1, $at); } else { prt("QUERY: No attribute? ****************************\n"); } } my $node_list2 = $dom2->selectNodes($node_name); my $ncnt2 = keys( %$node_list2 ); prt( "Got $ncnt2 nodes of $node_name ...\n" ); foreach my $node2 (in $node_list2) { ##prt( $node2->{Text} . "\n"); $at = $node2->getAttribute($att_name); if (length($at) > 0) { prt("Got [$att_name=\"$at\"] ...\n"); push(@src_list2, $at); } else { prt("QUERY: No attribute? ****************************\n"); } } } sub check_match { my ($i, $j); prt( "Checking for matches ...\n" ); for ($i = 0; $i < $pcnt1; $i++) { $fil1 = lc(file_name( $proj1[$i] )); prt( "matching [$fil1] with " ); for ($j = 0; $j < $pcnt2; $j++) { $fil2 = lc( file_name( $proj2[$j] ) ); if ($fil1 eq $fil2) { prt( "" . ($j + 1) . " in 2 ..." ); push(@pairs, $proj1[$i]); push(@pairs, $proj2[$j]); last; } } if ($j == $pcnt2) { prt( "NOT MATCHED IN 2!" ); } prt("\n"); } } sub get_vcproj_files { # got our two INPUT FILES ... process them ... if ($f1sln) { my $cnt = 0; my $pos = 0; my $cnt2 = 0; prt("Processing lines file 1 ...\n"); foreach $line (@file1) { chomp $line; $cnt++; ###prt("$cnt [".$line."]\n"); if ($line =~ /^Project/) { #if ($line =~ /^Project(.)=(.)/) { ## prt( "Got Project line ...\n" ); my @arr = split( /\"/, $line ); ## prt( "Got ". scalar @arr . " after split at inverted commas...\n" ); $cnt2 = 0; foreach my $bt (@arr) { ## prt( " ". ($cnt2 + 1) . " " . $bt); ## if ($bt =~ /=/) { ## $pos = $cnt2; ## prt(" with equal"); ## } if (is_vcproj($bt)) { my $dir = file_dirname($in_file1); my $pf = $dir . $bt; prt(" $bt is vcproj"); if ( -f $pf) { prt( " FOUND [$pf]!"); push(@proj1, $pf); } else { prt( " NO FIND [$pf]!" ); } prt("\n"); } ## prt("\n"); $cnt2++; } } } } if ($f2sln) { my $cnt = 0; my $pos = 0; my $cnt2 = 0; prt("Processing lines file 2 ...\n"); foreach $line (@file2) { chomp $line; $cnt++; ###prt("$cnt [".$line."]\n"); if ($line =~ /^Project/) { #if ($line =~ /^Project(.)=(.)/) { ## prt( "Got Project line ...\n" ); my @arr = split( /\"/, $line ); ## prt( "Got ". scalar @arr . " after split at inverted commas...\n" ); $cnt2 = 0; foreach my $bt (@arr) { ## prt( " ". ($cnt2 + 1) . " " . $bt); ## if ($bt =~ /=/) { ## $pos = $cnt2; ## prt(" with equal"); ##} if (is_vcproj($bt)) { my $dir = file_dirname($in_file1); my $pf = $dir . $bt; prt(" $bt is vcproj"); if ( -f $pf) { prt( " FOUND [$pf]!"); push(@proj2, $pf); } else { prt( " NO FIND [$pf]!" ); } prt("\n"); } ## prt("\n"); $cnt2++; } } } } } sub check_input { if (! -f $in_file1) { give_help("ERROR: Can not locate first file [$in_file1]!\n"); } if (! -f $in_file2) { give_help("ERROR: Can not locate second file [$in_file2]!\n"); } if (is_solution($in_file1)) { prt( "File 1 [$in_file1] has a solution extension ...\n" ); $f1sln = 1; } elsif (is_vcproj($in_file1)) { prt( "File 1 [$in_file1] has a project extension ...\n" ); push(@proj1, $in_file1); } else { mydie( "File 1 [$in_file1] is not a solution (sln), nor project (vcproj) extension ...\n" ); } if (is_solution($in_file2)) { prt( "File 1 [$in_file2] has a solution extension ...\n" ); $f2sln = 1; } elsif (is_vcproj($in_file2)) { prt( "File 2 [$in_file2] has a project extension ...\n" ); push(@proj2, $in_file2); } else { mydie( "File 2 [$in_file2] is not a solution (sln), nor project (vcproj) extension ...\n" ); } open( $IF1, "<$in_file1" ) or die( "ERROR: Can not OPEN $in_file1!\n" ); @file1 = <$IF1>; # slurp whole file, to an array of lines close($IF1); prt( "File 1 [$in_file1] has " . scalar @file1 . " lines...\n" ); open( $IF2, "<$in_file2" ) or die( "ERROR: Can not OPEN $in_file2!\n" ); @file2 = <$IF2>; # slurp whole file, to an array of lines close($IF2); prt( "File 2 [$in_file2] has " . scalar @file2 . " lines...\n" ); } sub is_solution { my $fil = shift; if ($fil =~ /\.sln$/i) { return 1; } return 0; } sub is_vcproj { my $fil = shift; if ($fil =~ /\.vcproj$/i) { return 1; } return 0; } sub give_help { my $msg = shift; prt( "$0 - Version: $vers...\n" ); prt( "Usage: [options] vc81 vc82...\n" ); prt( "options: --help or -h = this help\n" ); mydie( $msg ); } sub parse_arguments { my @av = @_; my $arg = ''; my $us = 0; while (@av) { $arg = $av[0]; if ($arg =~ /^-/) { # begins with a switch if (($arg eq "-h")||($arg eq "-?")||($arg eq "-help")||($arg eq "--help")) { give_help("Brief HELP only\n"); } else { give_help("ERROR: Unknown switched argument [$arg]!\n"); } } else { # unswitched $us++; if ($us == 1) { $in_file1 = $arg; if (! -f $in_file1) { give_help("ERROR: Can not locate first file [$in_file1]!\n"); } } elsif ($us == 2) { $in_file2 = $arg; if (! -f $in_file2) { give_help("ERROR: Can not locate second file [$in_file2]!\n"); } } else { give_help("ERROR: Only 2 unswitched agruments allowed!\n" . "argument [$arg] unknown!\n"); } } shift @av; } } ############################### # some utilities sub pos_of_last_slash { my $fil = shift; my $in1 = rindex( $fil, '/' ); my $in2 = rindex( $fil, '\\' ); my $pos = -1; # if BOTH exist if (($in1 >= 0) && ($in2 >= 0)) { # get the LAST if ($in1 > $in2) { $pos = $in1; } else { $pos = $in2; } } elsif ($in1 >= 0 ) { $pos = $in1; } elsif ($in2 >= 0 ) { $pos = $in2; } return $pos; } sub file_extension { my $fil = shift; my $pos = pos_of_last_slash($fil); my $last = rindex( $fil, '.' ); my $ext = ''; if ( $last >= 0 ) { if ($pos >= 0) { if ($last > $pos) { $ext = substr($fil, $last + 1); } } else { $ext = substr($fil, $last + 1); } } return $ext; } sub file_title { my $fil = shift; my $pos = pos_of_last_slash($fil); my $last = rindex( $fil, '.' ); my $tit = ''; if ($last >= 0) { if ($pos >= 0) { if ($last > $pos) { ###print "Using 1 substr( $fil, $pos+1, $last - $pos - 1 ) ...\n"; $tit = substr( $fil, $pos+1, $last - $pos - 1 ); } else { ###print "Using 2 substr( $fil, $pos+1 ) ...\n"; $tit = substr( $fil, $pos+1 ); } } else { ###print "Using 3 substr( $fil, 0, $last ) ...\n"; $tit = substr( $fil, 0, $last ); } } elsif ($pos >= 0) { ###print "Using 4 substr( $fil, $pos+1 ) ...\n"; $tit = substr( $fil, $pos+1 ); } else { ###print "Using 5 no slash, no dot ...\n"; $tit = $fil; } ##prt( "file_title returning [$tit] from [$fil] ...\n" ); return $tit; } sub file_name { my ($fil) = shift; my ($nam) = file_title($fil).".".file_extension($fil); return $nam; } # Return directory name of file. sub file_dirname { my ($fil) = shift; my ($pos) = pos_of_last_slash($fil); my ($len) = length( $fil ); my ($sub) = ""; if ($pos >= 0) { $sub = substr( $fil, 0, $pos + 1 ); } return $sub; } sub dirname { my ($file) = @_; my ($sub); ($sub = $file) =~ s,/+[^/]+$,,g; ###$sub = '.' if $sub eq $file; return $sub; } ################################ ### output and log file sub wlog { my $ml = shift; print $LOG $ml; } sub prt { my $m = shift; if ($write_log) { wlog($m); } print $m; } sub mydie { my $msg = shift; if ($write_log) { wlog($msg); } die $msg; } # eof = cmpvc8-01.pl