genslnlist.pl to HTML.

index -|- end

Generated: Tue Feb 2 17:54:40 2010 from genslnlist.pl 2008/09/16 3.5 KB.

#!Perl -w
use strict;
use warnings;
use File::Basename;
my $sln_file = 'fgfs\fgfs.sln';
my $vcp_file = 'fgfs\fgfs.vcproj';
my $out_file = 'slnlist.txt';
my $cnt = 0;
my ($proj, $file, @lines, $line, @arr);
my @projs = ();
my $do_create = 0;
my @outlist = ();
my @inlist = ($sln_file, $vcp_file);
my $exit_val = 0;
push(@inlist, "fgfs\\README.fgfs.txt");
if (open INF, "<$sln_file") {
   @lines = <INF>;
   close INF;
   prt( "Processing ".scalar @lines." lines from $sln_file ...\n" );
   foreach $line (@lines) {
      chomp $line;
      $line = trimall($line);
      if ($line =~ /Project\(.*=(.*)/) {
         $cnt++;
         ##prt( "$1\n" );
         @arr = split(/,/, $1);
         if (scalar @arr >= 2) {
            $proj = trimall($arr[0]);
            $file = trimall($arr[1]);
            $proj = removequotes($proj);
            $file = removequotes($file);
            $file = removerel($file);
            #prt( "$cnt [".$proj."] [".$file."] ...\n" );
            push(@projs, [ $proj, $file ]);
            push(@inlist, $file);
            prt( "$cnt $file\n" );
         }
      }
   }
   if (-f $out_file) {
      prt( "Checking current list ...\n" );
      if (open INF, "<$out_file") {
         @lines = <INF>;
         close INF;
         prt( "Processing ".scalar @lines." lines from $out_file ...\n" );
         $cnt = 0;
         foreach $line (@lines) {
            chomp $line;
            push(@outlist, $line);
            $cnt++;
            prt( "$cnt $line\n" );
         }
         if ( compare_lists() ) {
            $exit_val = 1;
            if (! write_out_file() ) {
               $exit_val = 2;
            }
         } else {
            write_out_file();   # write it anyway ...
            prt( "NO CHANGE REQUIRED IN $out_file ...\n" );
         }
      } else {
         prt( "ERROR: Failed to open $out_file ...\n" );
      }
   } else {
      prt( "Creating NEW $out_file ...\n" );
      $do_create = 1;
   }
} else {
   prt( "Failed to open $sln_file ...\n" );
}
exit($exit_val);
#########################################################
### subs only
sub write_out_file {
   my $retval = 1;
   prt( "Writting NEW templist.txt file ...\n" );
   if (open OUTF, ">templist.txt") {
      foreach $line (@inlist) {
         print OUTF $line."\n";
      }
      close OUTF;
      prt( "Check templist.txt, and if OK, copy to $out_file ...\n" );
   } else {
      prt( "ERROR: Unable to create templist.txt file ...\n" );
      $retval = 0;
   }
   return $retval;
}
sub trimall {
   my ($ln) = shift;
   $ln =~ s/\n/ /gm;   # replace CR (\n)
   $ln =~ s/\r/ /gm;   # replace LF (\r)
   $ln =~ s/\t/ /g;   # TAB(s) to a SPACE
   $ln = substr($ln,1) while ($ln =~ /^\s/); # remove all LEADING space
   $ln = substr($ln,0, length($ln) - 1) while ($ln =~ /\s$/); # remove all TRAILING space
   $ln =~ s/\s{2}/ /g while ($ln =~ /\s{2}/);   # all double space to SINGLE
   return $ln;
}
sub removequotes {
   my ($txt) = shift;
   $txt =~ s/^"//;
   $txt =~ s/"$//;
   return $txt;
}
sub removerel {
   my ($txt) = shift;
   $txt =~ s/^\.\.\\//;
   return $txt;
}
sub prt {
   my ($msg) = shift;
   print $msg;
}
sub compare_lists {
   my ($fnd, $lcln);
   my $diffs = 0;
   foreach $line (@inlist) {
      $lcln = lc($line);
      $fnd = 0;
      foreach $file (@outlist) {
         if ($lcln eq lc($file)) {
            $fnd = 1;
            last;
         }
      }
      if (! $fnd) {
         $diffs++;
         prt( "$line NOT FOUND in out file ...\n" );
      }
   }
   foreach $line (@outlist) {
      $lcln = lc($line);
      $fnd = 0;
      foreach $file (@inlist) {
         if ($lcln eq lc($file)) {
            $fnd = 1;
            last;
         }
      }
      if (! $fnd) {
         $diffs++;
         prt( "$line NOT FOUND in in file ...\n" );
      }
   }
   if ($diffs > 0) {
      prt( "Lists are NOT the same ...\n" );
   } else {
      prt( "Lists appear EXACTLY the same ...\n" );
   }
   return $diffs;
}
# eof - genslnlist.pl

index -|- top

checked by tidy  Valid HTML 4.01 Transitional