fixrelpath.pl to HTML.

index -|- end

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

index -|- top

checked by tidy  Valid HTML 4.01 Transitional