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