adjrt01.pl to HTML.

index -|- end

Generated: Tue Feb 2 17:54:17 2010 from adjrt01.pl 2006/06/23 10 KB.

#!/Perl
#
print "Hello, World... Adjust runtime library from '3' to '1' ...\n";
#   <Configurations>
#      <Configuration
#         Name="Debug|Win32"
# ...
#         ATLMinimizesCRunTimeLibraryUsage="false"
#         >
# ...
#          <Tool
#            Name="VCCLCompilerTool"
#            Optimization="0"
#            AdditionalIncludeDirectories="..\vc2005;..\zlib;..\png;..\jpeg;.."
#            PreprocessorDefinitions="_CRT_SECURE_NO_DEPRECATE;WIN32;_DEBUG;_WINDOWS;WIN32_LEAN_AND_MEAN;VC_EXTRA_LEAN;WIN32_EXTRA_LEAN"
#            RuntimeLibrary="3"
# ...
#         />
#      </Configuration>
#      <Configuration
#         Name="Release|Win32"
my $got_file = 1;
my $got_sln = 1;
my @sol_set = ();
my $sln_file = '';
my @proj_files = (); # hold the VCPROJ files to process
my $prj_cnt = 0;
my @warnings = ();
my $def_dir = 'C:\FG0910-3\fltk\vc2005';
my $in_dir = '';
if (@ARGV) {
   $in_dir = $ARGV[0];
} else {
   $in_dir = $def_dir;
}
my $root_dir = '';
# log file stuff
my ($LOG);
my $write_log = 0;
my $outfile = 'temp.'.$0.'.txt';
if ( open( $LOG, ">$outfile" ) ) {
    $write_log = 1;
} else {
    $write_log = 0;
    prt( "WARNING: Unable to open $outfile LOG ...\n" );
}
if ( -d $in_dir) {
   prt( "Using in directory of [$in_dir] ...\n" );
   $root_dir = $in_dir;
   $got_file = 0;
   $got_sln = 0;
} elsif ( -f $in_dir) {
   if (is_solution($in_dir)) {
      $got_sln = 1;
      prt( "Using SOLUTION in file of [$in_dir] ...\n" );
      $sln_file = $in_dir;
   } elsif (is_vcproj($in_dir)) {
      prt( "Using VCPROJ in file of [$in_dir] ...\n" );
      $got_sln = 0;
   } else {
      mydie( "ERROR: File is NOT solution or vcproj file - [$in_dir] ...\n" );
   }
} else {
   mydie( "ERROR: Can not locate file or folder [$in_dir] ...\n" );
}
if ($got_file) {
} else {
   # got a folder
   @sol_set = find_solution( $in_dir );
   my $sol_cnt = scalar @sol_set; 
   if ($sol_cnt == 1) {
      $sln_file = pop @sol_set;
      prt( "Got solution file [$sln_file] ...\n" );
      $got_file = 1;
      $got_sln = 1;
   } else {
      prt( "Got $sol_cnt solutions files ... Choose and enter one name only from ...\n" );
      $sol_cnt = 0;
      foreach $sln_file (@sol_set) {
         $sol_cnt++;
         prt( "$sol_cnt $sln_file ...\n" );
      }
      mydir( "Enter one of above file names ...\n" );
   }
}
if ($got_sln && ( -f $sln_file )) {
   get_proj_files($sln_file);
   $prj_cnt = scalar @proj_files;
   if ($prj_cnt) {
      prt( "Found $prj_cnt project files in $sln_file ...\n" );
   } else {
      mydir( "WARNING: Found NO project files in $sln_file ...\n" );
   }
}
if ($prj_cnt) {
   prt( "Processing $prj_cnt project files ...\n" );
   foreach my $file (@proj_files) {
      process_proj_file($file);
   }
}
close_log();
exit(0);
sub process_proj_file {
   my ($file) = shift;
   if ( ! -f $file) {
      push(@warnings, "WARNING: Unable to open $file ...\n");
      return;
   }
   my ($in_cfgs, $in_cfg, $in_tool, $aline, $ln, $pl2, $had_nm, $vers, $in_cfg2, $rt, $tn);
   my ($chged, $pline);
   open IF, "<$file";
   my @plines = <IF>;
   close(IF);
   prt( "\nProcessing ".scalar @plines. " lines of $file ...\n" );
   $in_cfgs = 0;
   $in_cfg = 0;
   $in_cfg2 = 0;
   $in_tool = 0;
   $aline = '';
   $ln = 0;
    ##my $dbg = 'Name="Debug\\|Win32"';
    ##my $rel = 'Name="Release\\|Win32"';
   ##my $dr = 'Name="(\\w)+\\|Win32"';
   my $dr = 'Name="(\\w+)\\|Win32"';
   my $tl = 'Name="(\\w+)"';
   my $rtl = 'RuntimeLibrary="(\\d{1})"';
   $had_nm = 0;
   $vers = '';
   $rt = '';
   $tn = '';
   $chged = 0;
   foreach $pline (@plines) {
      $ln++;
      $pl2 = $pline;
      chomp $pl2;
      while ($pl2 =~ /\t/) {
         $pl2 =~ s/\t/ /g;
      }
      while ($pl2 =~ /  /) {
         $pl2 =~ s/  / /g;
      }
      if ($in_cfgs) {
         if ($pline =~ m|</Configurations>|) {
            prt( "$ln End configurations ... [$pl2]\n");
         }
      } else {
         if ($pline =~ m|<Configurations>|) {
            prt( "$ln In Configurations ... [$pl2]\n");
            $in_cfgs = 1;
         }
      }
      if ($in_cfgs) {
         if ($pline =~ m/<Configuration[\s|\W]+/) {
            $in_cfg = 1;
            $in_cfg2 = 1;
            prt( "$ln In configuration ... [$pl2]\n");
            if ($pline =~ />/) {
               $in_cfg = 0;
               prt( "$ln Out configuration ... [$pl2]\n");
            }
         }
         if ($in_cfg) {
            if ($pline =~ />/) {
               $in_cfg = 0;
               prt( "$ln Out configuration ... [$pl2]\n");
            }
         }
         if ($in_cfg) {
            ###prt( "In cfg with [$pl2]\n" );
            if ($pline =~ /$dr/) {
               $vers = $1;
               prt( "$ln *** Got $vers ... ***\n" );
            }
         }
         if ($in_cfg2) {
            if ($pline =~ m|</Configuration>|) {
               prt( "$ln End configuration ... [$pl2]\n");
               $in_Cfg2 = 0;
            }
         }
         if ($in_cfg2) {
            if ($pline =~ /<Tool[\s|\W]/) {
               $in_tool = 1;
               prt( "$ln In Tool ... [$pl2]\n" );
            }
            if ($in_tool) {
               if ($pline =~ m|/>| ) {
                  prt( "$ln End Tool ... [$pl2]\n");
                  $in_tool = 0;
               }
            }
            if ($in_tool) {
               if ($pline =~ /$tl/) {
                  $tn = $1;
                  prt( "$ln *** Got Name=$tn ... [$pl2]***\n" );
               }
               if ($tn eq 'VCCLCompilerTool') {
                  if ($pline =~ /$rtl/) {
                     $rt = $1;
                     prt( "$ln *** Runtime=\"$rt\" ... [$pl2]***\n" );
                     if ($vers eq 'Debug') {
                        if ($rt ne '1') {
                           $pline =~ s/$rt/1/;
                           prt("$ln CHANGED RT to [$pline]\n" );
                           $chged++;
                           $plines[$ln - 1] = $pline;
                        }
                     } elsif ($vers eq 'Release') {
                        if ($rt ne '0') {
                           $pline =~ s/$rt/0/;
                           prt("$ln CHANGED RT to [$pline]\n" );
                           $chged++;
                           $plines[$ln - 1] = $pline;
                        }
                     }
                  }
               }
            }
         } # in Configuration
      }
   }
   if ($chged) {
      prt("Outputting the changes ...\n");
      my $bak = $file . '.bak';
      ###my $bakn = file_name($bak);
      if ( -f $bak) {
         prt("Removing old backup [$bak] ...\n");
         unlink $bak;
      }
      prt( "Renaming $file to $bak ...\n" );
      rename $file, $bak;
      prt( "Creating new file ...\n" );
      open OF, ">$file";
      foreach $pline (@plines) {
         print OF $pline;
      }
      close(OF);
      prt( "Done $file ...\n" );
   }
}
sub find_solution {
   my ($dir) = shift;
   opendir THEDIR, $dir or mydie( "ERROR: Can NOT open directory $dir ...\n" );
   local @files = readdir(THEDIR);
   closedir(THEDIR);
   local @solution = ();
   foreach my $f (@files) {
      if (is_solution($f)) {
         my $ff = $dir."\\".$f;
         push(@solution, $ff);
      }
   }
   return @solution;
}
sub get_proj_files {
   my ($in_file) = shift;
   my $cnt, $cnt2;
    open $IF, "<$in_file" or mydie( "ERROR: Can not OPEN $in_file!\n" );
    local @lines = <$IF>; # slurp whole file, to an array of lines
    close($IF);
   my $dir = file_dirname($in_file);
   prt("Processing ".scalar @lines. " lines of $in_file ...\n");
   $cnt = 0;
   foreach my $line (@lines) {
      chomp $line;
      $cnt++;
      if ($line =~ /^Project/) {
         my @arr = split( /\"/, $line );
         ## prt( "Got ". scalar @arr . " after split at inverted commas...\n" );
         $cnt2 = 0;
         foreach my $bt (@arr) {
            if (is_vcproj($bt)) {
               my $pf = $dir . $bt;
               ##prt("$bt is vcproj ");
               if ( -f $pf) {
                  ##prt( "FOUND [$pf]!");
                  push(@proj_files, $pf);
               } else {
                  prt( "NO FIND [$pf]!\n" );
               }
               ###prt("\n");
            }
            $cnt2++;
         }
      }
   }
}
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;
}
###############################
# 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;
}
################################
### output and log file
sub wlog {
   my $ml = shift;
   print $LOG $ml;
}
sub prt {
   my $m = shift;
   if ($write_log) {
      wlog($m);
   }
   print STDOUT $m;
}
sub mydie {
   my $msg = shift;
   if ($write_log) {
      wlog($msg);
   }
   die $msg;
}
sub log_close {
   if ($write_log) {
      close( $LOG );
   }
}
sub close_log {
   if ($write_log) {
      prt( "Closing LOG file, and passing to 'system($outfile)'\nMay need to CLOSE notepad to continue ...\n" );
      log_close();
      system( $outfile );
   }
}
# eof - adjrt01.pl

index -|- top