Generated: Tue Feb 2 17:54:39 2010 from fixrelpath.pl 2007/10/04 3.2 KB.
#!/perl -w ######################################################################## # NAME: fixrelpath.pl # AIM: Read a set of VCPROJ files, from a SOLUTION file, or FOLDER, # and AMEND the relative path, and write back the file ... # 04/10/2007 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); prt( "$0 ... Hello, World ...\n" ); my $in_file = 'C:\FG\FGCOM\xmlrpc-c\Windows\VC8\xmlrpc.sln'; my @in_projs = (); my $prjcnt = 0; my @warnings = (); @in_projs = process_sln( $in_file ); $prjcnt = scalar @in_projs; prt( "Got $prjcnt project files ...\n" ); for (my $i = 0; $i < $prjcnt; $i++) { my $ff = $in_projs[$i][2]; my $st = "ok"; $st = "FAILED" if !( -f $ff); prt( "$ff - $st\n" ); } close_log($outfile,0); exit(0); ################################# # Process a SOLUTION file, and extract all projects within. # sub process_sln { my ($fil) = shift; my ($lc, $wmsg, $line); ###my ($fil_nm,$fil_dir,$fil_ext) = fileparse( $fil, qr/\.[^.]*/ ); my ($fil_nm,$fil_dir) = fileparse( $fil ); my @projs = (); prt( "Processing SLN file [$fil_nm] in [$fil_dir]...\n" ); if ( !open INF, "<$fil" ) { $wmsg = "WARNING: Unable to open [$fil] ..."; prt( "$wmsg\n" ); push(@warnings, $wmsg); return @projs; } my @lines = <INF>; close INF; $lc = scalar @lines; prt( "Processing $lc lines ...\n" ); my $cnt = 0; foreach $line (@lines) { $line = trim_all($line); if ($line =~ /Project\(.*=(.*)/) { $cnt++; ##prt( "$1\n" ); my @arr = split(/,/, $1); if (scalar @arr >= 2) { $arr[0] = trim_all($arr[0]); $arr[1] = trim_all($arr[1]); $arr[0] = substr($arr[0],1,length($arr[0])-2); $arr[1] = substr($arr[1],1,length($arr[1])-2); prt( "$cnt [".$arr[0]."] [".$arr[1]."] ...\n" ); my $rf = unix_2_dos($arr[1]); # relative ADJUSTMENT $rf = "..\\".$rf if ($rf =~ /^\.\.\\/); my $ff = fix_rel($fil_dir.$rf); push(@projs, [ $arr[0], $rf, $ff ]); } } } $cnt = scalar @projs; prt( "Done $lc lines ... $cnt projects ...\n" ); ##for (my $i = 0; $i < $cnt; $i++) { ## process_vcproj( fix_rel($fil_dir.$projs[$i][1]) ); ##} return @projs; } sub unix_2_dos { my ($f) = shift; $f =~ s/\//\\/g; return $f; } sub fix_rel { my ($path) = shift; $path = unix_2_dos($path); # ensure DOS separator my @a = split(/\\/, $path); # split on DOS separator my $npath = ''; my $wmsg = ''; my $max = scalar @a; my @na = (); for (my $i = 0; $i < $max; $i++) { my $p = $a[$i]; if ($p eq '.') { # ignore this } elsif ($p eq '..') { if (@na) { pop @na; # discard previous } else { $wmsg = "WARNING: Got relative .. without previous!!! [$path]"; prt( "$wmsg\n" ); push(@warnings,$wmsg); } } else { push(@na,$p); } } foreach my $pt (@na) { $npath .= "\\" if length($npath); $npath .= $pt; } return $npath; } # eof - fixrelpath.pl