vc8cmp-02.pl to HTML.

index -|- end

Generated: Tue Feb 2 17:54:59 2010 from vc8cmp-02.pl 2006/07/27 12.2 KB.

#!/Perl
# 
use strict;
use Cwd;
use Win32::OLE qw(in with);
my $LF;
my $outfile = 'temp'.$0.'.txt';
require "logfile.pl" or die "Missing logfile.pl ...\n";
open_log($outfile);
prt( "$0 ... Hello, World... output to $outfile ...\n" );
my $debug_on = 0;
my $use_multi  = 0;
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_file1 = "f:\\fgcvs\\flightgear\\source\\projects\\vc8\\flightgear.sln";
my $in_file2 = "f:\\FG0910-4\\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 @proj1 = ();
my @proj2 = ();
my $line = "";
my $pcnt1 = 0;
my $pcnt2 = 0;
my $fil1 = "";
my $fil2 = "";
my @pairs = ();
my $pcnt = 0;
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( "Have $pcnt1 vcproj files from file 1 ...\n" );
prt( "Have $pcnt2 vcproj files from file 2 ...\n" );
check_match();
if ($use_multi) {
   $pcnt = scalar @pairs;
   prt("Have $pcnt pairs of vcproj files...\n");
   for (my $i = 0; $i < $pcnt ; $i++) {
      $fil1 = $pairs[$i][0];
      $fil2 = $pairs[$i][1];
      compare_files( $fil1, $fil2 );
   }
} else {
   $pcnt = ( scalar @pairs ) / 2;
   prt("Have $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 @nomat1 = ();
my @nomat2 = ();
my ($fnd, $i, $j);
prt("\nComparing sorted lists $scnt1 with $scnt2 files...\n");
prt("Comparing those in\n");
prt("1 [$in_file1], with\n");
prt("2 [$in_file2]...\n");
for ($i = 0; $i < $scnt1; $i++) {
   $fil1 = lc($ssrc_list1[$i]);
   $fnd = 0;
   for ($j = 0; $j < $scnt2; $j++) {
      $fil2 = lc($ssrc_list2[$j]);
      if ($fil1 eq $fil2) {
         $ssrc_list2[$j] = "FOUND AT $i offset";
         $fnd = 1;
         last;
      }
   }
   if ($fnd) {
      prtd( "Found [$fil1] in BOTH ...\n" );
   } else {
      prt( "No match for [".$ssrc_list1[$i]."] ...\n" );
      push(@nomat1, $i);
   }
}
if (@nomat1) {
   prt("This suggests ".scalar @nomat1." file(s) have been DELETED from 2 ...\n");
} else {
   prt("No deletions found ...\n");
}
prt("\nReverse compare - Comparing those in\n");
prt("2 [$in_file2], with\n");
prt("1 [$in_file1]...\n");
for ($j = 0; $j < $scnt2; $j++) {
   $fil2 = $ssrc_list2[$j];
   if ( !($fil2 =~ /^FOUND/) ) {
      prt( "No match for [$fil2] ...\n" );
      push(@nomat2, $j);
   }
}
if (@nomat2) {
   prt("This suggests ".scalar @nomat2." file(s) have been ADDED to 2 ...\n");
} else {
   prt("No additions found ...\n");
}
prt("Done $i with $j file compares ...\n" );
close_log($outfile,1);
exit 0;
#####################################################
sub compare_files {
   my ($f1, $f2) = @_;
   my $at;
   prt("Comparing -\n[$f1] with \n[$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) {
         prtd("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) {
         prtd("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 ...\n" );
            prt( "[".$proj1[$i]."]with[".$proj2[$j]."]");
            if ($use_multi) {
               push(@pairs, [$proj1[$i], $proj2[$j]]); 
            } else {
               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_file2);
                  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 2 [$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;
}
sub prtd {
   my ($msg) = shift;
   if ($debug_on) {
      prt($msg);
   }
}
# eof = cmpvc8-02.pl

index -|- top

checked by tidy  Valid HTML 4.01 Transitional