Generated: Tue Feb 2 17:54:39 2010 from fixdsp01.pl 2009/02/25 4.8 KB.
#!/perl -w # NAME: fixdsp01.pl # AIM: Very specific changes to be made to a set of DSP files # In this case, change library output back to normal location - that # is remove the out:"..\..\lib" from the LIB32 lines, AND # change the LINK32 line out:"..\..\bin\<something> to # out:"bin\<something>, and write a NEW amended DSP # if $outtmpfile is 0 (after renaming the current to OLD/BAK) # else output a temp.Nnamed>.dsp locally otherwise. # 25/02/2009 - geoff mclane - http://geoffair.net/mperl use strict; use warnings; use File::Basename; require 'logfile.pl' or die "Unable to load logfile.pl ...\n"; # log file stuff my ($LF); my $pgmname = $0; if ($pgmname =~ /\w{1}:\\.*/) { my @tmpsp = split(/\\/,$pgmname); $pgmname = $tmpsp[-1]; } my $outfile = "temp.$pgmname.txt"; open_log($outfile); my $outtmpfile = 1; # change to '0' to do the write the changed files my $in_folder = "C:\\FG\\27\\terragear-cs\\projects\\msvc"; prt( "$0 ... Processing $in_folder...\n" ); sub get_files($) { my ($ind) = shift; my @dsp_files = (); if (opendir( DIR, $ind )) { my @files = readdir(DIR); closedir DIR; foreach my $file (@files) { next if (($file eq ".") || ($file eq "..")); my $ff = $ind."\\".$file; if ( -d $ff ) { # what to do with sub-directories } else { if ((length($file) > 4) && (substr($file,-4) =~ /\.dsp/i)) { # prt( "File: $file\n" ); push(@dsp_files, $ff); } } } } else { prt( "ERROR: Unable to open directory [$ind]...\n" ); } return @dsp_files; } sub fix_line1($$$) { my ($ln, $v, $nv) = @_; my $len = length($ln); my $nline = ''; my ($end, $ind); $ind = index($ln, $v); if ($ind != -1) { $nline = substr($ln,0,$ind); $end = substr($ln,$ind + length($v)); $nline .= $nv; $nline .= $end; return $nline; } return $ln; } sub process_files($) { my ($flr) = shift; my $cnt = scalar @$flr; prt( "Processing $cnt files...\n" ); my ($val, $nval, $ind, $outfile); foreach my $file (@$flr) { my ($nm, $dir) = fileparse( $file ); if (open INF, "<$file") { my @lines = <INF>; close INF; my $lncnt = scalar @lines; my $type = 'UNKNOWN'; my $chgs = 0; my $chgd = ''; for (my $i = 0; $i < $lncnt; $i++) { my $line = $lines[$i]; my $len = length($line); if ($line =~ /^#\s+TARGTYPE\s+"(.+)"/) { my $tt = $1; # prt( "TYPE [$tt]\n" ); if ($tt =~ /Console/) { $type = 'Console'; } elsif ($tt =~ /Library/) { $type = "Library"; } } elsif (substr($line,0,1) eq '#') { if ($type eq 'Console') { # # ADD LINK32 ...86 /out:"..\..\bin\tgvpf.exe" /libpath..." if ($line =~ /\s+LINK32\s+/) { if ($line =~ /\/out:"(\S+)"/) { $val = $1; if ($val =~ /^\.\.\\\.\.\\/) { $nval = substr($val,6); $line = fix_line1($line, $val, $nval); #my $qval = quotemeta($val); #my $qnval = quotemeta($nval); #$line = s/$qval/$qnval/; $lines[$i] = $line; $chgd .= "($val-$nval)"; $chgs++; } } } } elsif ($type eq 'Library') { # # ADD LIB32 /nologo /out:"..\..\lib\libArray.lib" if ($line =~ /\s+LIB32\s+/) { if ($line =~ /(\s+\/out:"\S+")/) { $val = $1; $ind = index($line, $val); if ($ind != -1) { $nval = substr($line, $ind + length($val)); $line = substr($line,0,$ind); $lines[$i] = $line . $nval; $chgd .= "($val)"; $chgs++; } } } } } } prt( "file: $nm, $lncnt lines... $type $chgs [$chgd]\n" ); if ($outtmpfile) { $outfile = 'temp.'.$nm; } else { rename2oldbak($file); $outfile = $file; } write_a_file($outfile, @lines); } else { prt("ERROR: can not open [$file]!\n"); } } } my @file_list = get_files( $in_folder ); process_files( \@file_list ); close_log($outfile,1); exit(0); # eof - fixdsp01.pl