reltest.pl to HTML.

index -|- end

Generated: Sun Apr 15 11:46:41 2012 from reltest.pl 2012/04/13 4.7 KB.

#!/perl -w
# NAME: reltest.pl
# AIM: Test my relative.pl module ... 
use strict;
use warnings;
use Cwd;
require 'relative.pl' or die "Unable to load relative.pl ...\n";

my $os = $^O;
my $os_is_win = ($os =~ /Win/i) ? 1 : 0;

my $currdir = cwd();
print "Current directory: [$currdir]\n";
my $base_path = "C:\\GTools\\";
my $sln_path = "C:\\GTools\\tools\\bglview2\\";
my $fil_path = "C:\\GTools\\tools\\bglview2\\BvMath\\";
my $fil_path2 = "C:\\GTools\\utils\\";

my $dsp_path = "C:\\GTools\\perl";
my $fil2_path = "C:\\Projects\\foo\\build";
my $PATH_SEP = ($os_is_win) ? "\\" : "/";

sub prt($) { print shift; }

sub sub_base {
   my ($pth) = shift;
   $pth = substr($pth,length($base_path));
   return $pth;
}

# 20120413 - Another try to get this RIGHT
sub get_relative_path4($$) {
    my ($to,$from) = @_;
    my $cos = $^O;
    my $cos_is_win = ($cos =~ /Win/i) ? 1 : 0;
    #prt("OS is ".(($cos_is_win) ? "Windows" : "Unix")."\n");
   # remove drives, if present
    if ($cos_is_win) {
        $to = path_u2d($to);
        $from = path_u2d($from);
    } else {
        $to = path_d2u($to);
        $from = path_d2u($from);
    }
    my ($cpos);
    if ($cos_is_win) {
        if ( ($cpos = index($to, ":")) != -1 ) {
            $to = substr($to, $cpos+1 );
        }
        if ( ($cpos = index( $from, ":" )) != -1 ) {
            $from = substr($from, $cpos+1 );
        }
        # should check DRIVES are the SAME
    }
    # remove leading '\' or '/'
    $to =~ s/^(\\|\/)//;
    $from =~ s/^(\\|\/)//;
    # remove trailing '\' or '/', if present
    $to =~ s/(\\|\/)$//;
    $from =~ s/(\\|\/)$//;

    # get path arrays
    my (@arr0,@arr1,@arr2);
    if ($cos_is_win) {
        @arr0 = split(/\\/,$to);
        $to = lc($to);
        $from = lc($from);
        @arr1 = split(/\\/,$to);
        @arr2 = split(/\\/,$from);
    } else {
        @arr0 = split(/\//,$to);
        @arr1 = split(/\//,$to);
        @arr2 = split(/\//,$from);
    }
    my $len1 = scalar @arr1;
    my $len2 = scalar @arr2;
    my $max = ($len1 < $len2) ? $len1 : $len2;
    my ($ccnt,$comcnt,$sub1,$sub2);
    $comcnt = 0;
    # eliminate common start, if any
    for ($ccnt = 0; $ccnt < $max; $ccnt++) {
        $sub1 = $arr1[$ccnt];
        $sub2 = $arr2[$ccnt];
        if ($sub1 eq $sub2) {
            $comcnt++;
            # prt("sm [$sub1] == [$sub2] ");
        } else {
            last;
        }
    }
    # prt("Common $comcnt");
    # back up for the difference remaining of the from
    $cpos = $len2 - $comcnt;
    my $relpath = '';
    # prt(", backup $cpos to get out of [$from]$len2 ");
    while ($cpos) {
        $relpath .= "..".$PATH_SEP;
        $cpos--;
    }
    # append to remaining to components
    $cpos = $len1 - $comcnt;
    # prt(", append $cpos of [$to]$len1");
    for (;$comcnt < $len1 ; $comcnt++) {
        $relpath .= $arr0[$comcnt].$PATH_SEP;
    }
    # prt(", result [$relpath]\n");
    return $relpath;
}

my $rel_path1 = get_rel_dos_path($sln_path, $fil_path);
print "Rel Path: $rel_path1 (to ".sub_base($sln_path).", from ".sub_base($fil_path).")\n";
my $rel_path4 = get_rel_dos_path($fil_path, $sln_path );
print "Rel Path: $rel_path4 (to ".sub_base($fil_path).", from ".sub_base($sln_path).")\n";

my $rel_path2 = get_rel_dos_path($sln_path, $fil_path2);
print "Rel Path: $rel_path2 (to ".sub_base($sln_path).", from ".sub_base($fil_path2).")\n";
my $rel_path3 = get_rel_dos_path($fil_path2, $sln_path);
print "Rel Path: $rel_path3 (to ".sub_base($fil_path2).", from ".sub_base($sln_path).")\n";

my $rel_path5 = get_rel_dos_path($dsp_path,$fil2_path);
print "Rel Path: $rel_path5 (to [$dsp_path] from [$fil2_path])\n";
my $rel_path6 = get_rel_dos_path($fil2_path,$dsp_path);
print "Rel Path: $rel_path5 (to [$fil2_path] from [$dsp_path])\n";
print "\n";
$rel_path5 = get_relative_path4($dsp_path,$fil2_path);
prt("Rel Path: $rel_path5 (to [$dsp_path] from [$fil2_path])\n");
$rel_path6 = get_relative_path4($fil2_path,$dsp_path);
prt("Rel Path: $rel_path6 (to [$fil2_path] from [$dsp_path])\n");

$rel_path1 = get_relative_path4($sln_path, $fil_path);
print "Rel Path: $rel_path1 (to ".sub_base($sln_path).", from ".sub_base($fil_path).")\n";
$rel_path4 = get_relative_path4($fil_path, $sln_path );
print "Rel Path: $rel_path4 (to ".sub_base($fil_path).", from ".sub_base($sln_path).")\n";
$rel_path2 = get_relative_path4($sln_path, $fil_path2);
print "Rel Path: $rel_path2 (to ".sub_base($sln_path).", from ".sub_base($fil_path2).")\n";
$rel_path3 = get_relative_path4($fil_path2, $sln_path);
print "Rel Path: $rel_path3 (to ".sub_base($fil_path2).", from ".sub_base($sln_path).")\n";

# eof - reltest.pl

index -|- top