chkrelpath.pl to HTML.

index -|- end

Generated: Tue Feb 2 17:54:25 2010 from chkrelpath.pl 2008/10/30 5.1 KB.

#!/perl -w
# NAME: chkrelpath.pl
# AIM: Just to test and check the relative path generation
use strict;
use warnings;
require 'fgutils.pl' or die "Unable to load fgutils.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 $dbg_chk_rel = 1;
my $root_path = "C:\\FG\\20\\";
my $in_path = $root_path."FlightGear\\src\\main\\";
my $dsp_path = $root_path."fgfs\\";
my $rel_path = chk_get_rel_dos_path( $in_path, $dsp_path );
prt( "From [$dsp_path] to [$in_path], got [$rel_path] ...\n" );
#$in_path = $root_path."FlightGear\\src\\main";
#$dsp_path = $root_path."fgfs";
#$rel_path = chk_get_rel_dos_path( $in_path, $dsp_path );
#prt( "From [$dsp_path] to [$in_path], got [$rel_path] ...\n" );
close_log($outfile,0);
exit(0);
sub chk_get_relative_path {
   my ($target, $fromdir) = @_;
    my $dbg_rel = 0;
   my ($colonpos, $path, $posval, $diffpos, $from, $to);
   my ($tlen, $flen);
    my ($lento, $lenfrom);
   my $retrel = "";
   # only work with slash - convert DOS backslash to slash
   $target = path_d2u($target);
   $fromdir = path_d2u($fromdir);
   # add '/' to target. if missing
   if (substr($target, length($target)-1, 1) ne '/') {
      $target .= '/';
   }
   # add '/' to fromdir. if missing
   if (substr($fromdir, length($fromdir)-1, 1) ne '/') {
      $fromdir .= '/';
   }
   # remove drives, if present
    if ( ( $colonpos = index( $target, ":" ) ) != -1 ) {
      $target = substr( $target, $colonpos+1 );
   }
   if ( ( $colonpos = index( $fromdir, ":" ) ) != -1 ) {
        $fromdir = substr( $fromdir, $colonpos+1 );
    }
   # got the TO and FROM ...
   $to = $target;
   $from = $fromdir;
    $lento = length($to);
    $lenfrom = length($from);
   print "To [$to]$lento, from [$from]$lenfrom ...\n" if ($dbg_chk_rel);
   $path = '';
   $posval = 0;
   $retrel = '';
   # // Step through the paths until a difference is found (ignore slash differences)
   # // or until the end of one is found
    my $ch1 = substr($to,$posval,1);
    my $ch2 = substr($from,$posval,1);
    my $dif = (($ch1 eq $ch2) ? "same" : "different");
   while ( ($posval < $lento) && ($posval < $lento) ) {
      if ( lc(substr($from,$posval,1)) eq lc(substr($to,$posval,1)) ) {
         $posval++; # bump to next
      } else {
         last; # break;
      }
   }
   # // Save the position of the first difference
   $diffpos = $posval;
    if ($dbg_chk_rel) {
        ##$dif = (($ch1 eq $ch2) ? "equal" : "different");
        $ch1 = substr($to,$posval,1);
        $ch2 = substr($from,$posval,1);
        $dif = (($ch1 eq $ch2) ? "same" : "different");
       print "First difference found at $posval ... [$ch1] NE [$ch2] ... $dif\n";
        print "Bal of to = [".substr($to,$posval)."]\n";
        print "Bal of from=[".substr($from,$posval)."]\n";
    }
   # // Check if the directories are the same or
   # // the if target is in a subdirectory of the fromdir
   if ( ( !($posval < $lenfrom) ) &&
       ( substr($to,$posval,1) eq "/" || !($posval < $lento) ) )
   {
      # // Build relative path
      $diffpos = length($target);
        my $chk1 = ( substr($from,$posval,1)        ? "got from" : "no from");
        my $chk2 = ( (substr($to,$posval,1) eq "/") ? "to /" : "no /");
        my $chk3 = ( substr($to,$posval,1)          ? "got to" : "no to" );
       print "Build relative path ($diffpos) ... cond [$chk1] [$chk2] [$chk3]\n" if ($dbg_chk_rel);
      if (($posval + 1) < $diffpos) {
         $diffpos-- if ($diffpos);
         if ($diffpos > $posval) {
            $diffpos -= $posval;
         } else {
            $diffpos = 0;
         }
         ###$retrel = substr( $target, $posval+1, length( $target ) );
         print "Return substr of target, from ".($posval+1).", for $diffpos length ...\n" if ($dbg_chk_rel);
         $retrel = substr( $target, $posval+1, $diffpos );
      } else {
         print "posval+1 (".($posval+1).") greater than length $diffpos ...\n" if ($dbg_chk_rel);
      }
   } else {
      # // find out how many "../"'s are necessary
      # // Step through the fromdir path, checking for slashes
      # // each slash encountered requires a "../"
      #$posval++;
      print "Check for slashes ... from $posval onwards in ".substr($from,$posval)."\n" if ($dbg_chk_rel);
      while ( $posval < $lenfrom ) {
         if ( substr($from,$posval,1) eq "/" ) { # || ( substr($from,$posval,1) eq "\\" ) ) {
            print "Found a slash, add a '../' \n" if ($dbg_chk_rel);
            $path .= "../";
         }
         $posval++;
      }
      print "Path [$path] ...\n" if ($dbg_rel);
      # // Search backwards to find where the first common directory
      # // as some letters in the first different directory names
      # // may have been the same
      $diffpos--;
      while ( ( substr($to,$diffpos,1) ne "/" ) && substr($to,$diffpos,1) ) {
         $diffpos--;
      }
      # // Build relative path to return
      $retrel = $path . substr( $target, $diffpos+1, length( $target ) );
    }
   print "Returning [$retrel] ...\n" if ($dbg_chk_rel);
   return $retrel;
}
sub chk_get_rel_dos_path {
   my ($targ, $from) = @_;
   my $rp = chk_get_relative_path($targ, $from);
   $rp = path_u2d($rp);
   return $rp;
}
# eof

index -|- top