#!/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
