relative.pl to HTML.

index -|- end

Generated: Sun Aug 21 11:11:24 2011 from relative.pl 2010/08/25 7.6 KB.

#!/perl -w
# NAME: relative.pl
# AIM: Given a TARGET path, get RELATIVE path FROM a directory
my $dbg_rel = 0;
my $dbg_rel2 = 0;

sub set_dbg_rel2($) { $dbg_rel2 = shift; };

# ENSURE '/' is used throughout string.
sub path_d2u($) {
   my ($du) = shift;
   $du =~ s/\\/\//g;
   return $du;
}

sub path_u2d($) {
   my ($ud) = shift;
   $ud =~ s/\//\\/g;
   return $ud;
}

# Given TWO FOLDER, attempt to get RELATIVE PATH from the FROM DIRECTORY,
# to the TARGET DIRECTORY. MUSTS BE DIRECTORIES, NOT FILE PATHS
##my $rel = get_relative_path( $htm_folder, $my_folder ); added 20070820
# seems to work fine ... still under test!!!
# 17/11/2007 - Further refinement to REMOVE all warnings
sub get_relative_path {
   my ($target, $fromdir) = @_;
   my ($colonpos, $path, $posval, $diffpos, $from, $to);
   my ($tlen, $flen);
   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;
   print "To [$to], from [$from] ...\n" if ($dbg_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
   while ( substr($from,$posval,1) && substr($to,$posval,1) ) {
      if ( substr($from,$posval,1) eq substr($to,$posval,1) ) {
         $posval++; # bump to next
      } else {
         last; # break;
      }
   }

   # // Save the position of the first difference
   $diffpos = $posval;

   # // Check if the directories are the same or
   # // the if target is in a subdirectory of the fromdir
   if ( ( !substr($from,$posval,1) ) &&
       ( substr($to,$posval,1) eq "/" || !substr($to,$posval,1) ) )
   {
      # // Build relative path
      $diffpos = length($target);
      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_rel);
         $retrel = substr( $target, $posval+1, $diffpos );
      } else {
         print "posval+1 (".($posval+1).") greater than length $diffpos ...\n" if ($dbg_rel);
      }
   } else {
      # // find out how many "../"'s are necessary
      # // Step through the fromdir path, checking for slashes
      # // each slash encountered requires a "../"
      #$posval++;
      while ( substr($from,$posval,1) ) {
         print "Check for slash ... $posval in $from\n" if ($dbg_rel);
         if ( substr($from,$posval,1) eq "/" ) { # || ( substr($from,$posval,1) eq "\\" ) ) {
            print "Found a slash, add a '../' \n" if ($dbg_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_rel);
   return $retrel;
}

sub get_relative_path_2 {
   my ($target, $fromdir) = @_;
   my ($colonpos, $path, $posval, $diffpos);
    ##my ($from, $to);
   my ($tlen, $flen);
    my ($tolen, $fromlen);
    my ($cht, $chf);
   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;
    $tolen = length($target);
    $fromlen = length($fromdir);
   prt( "To   [$target]($tolen),\nfrom [$fromdir]($fromlen) ...\n" ) if ($dbg_rel2);
   $path = '';
   $posval = 0;
   $retrel = '';
   # // Step through the paths until a difference is found (ignore slash differences)
   # // or until the end of one is found
   # while ( substr($from,$posval,1) && substr($to,$posval,1) ) {
   while ( ($posval < $tolen) && ($posval < $fromlen) ) {
        $chf = substr($fromdir,$posval,1);
        $cht = substr($target,$posval,1);
      if ( $chf eq $cht ) {
         $posval++; # bump to next
      } else {
            prt( "First diff [$chf] ne [$cht] ...\n" ) if ($dbg_rel2);
         last; # break;
      }
   }
   ##if ( !substr($from,$posval,1) ) {
   if ( $posval >= $fromlen ) {
        prt( "Ran out of from ...\n" ) if ($dbg_rel2);
    }
    ##if ( !substr($to,$posval,1) ) {
    if ( $posval >= $tolen ) {
        prt( "Ran out of to ...\n" ) if ($dbg_rel2);
    }

   # // Save the position of the first difference
   $diffpos = $posval;
    prt( "First diff found at offset $posval ... ".substr($target,$posval)." ...\n" ) if ($dbg_rel2);

   # // Check if the directories are the same or
   # // the if target is in a subdirectory of the fromdir
   if ( ( !substr($fromdir,$posval,1) ) &&
       ( substr($target,$posval,1) eq "/" || !substr($target,$posval,1) ) )
   {
      # // Build relative path
      $diffpos = length($target);
      if (($posval + 1) < $diffpos) {
         $diffpos-- if ($diffpos);
         if ($diffpos > $posval) {
            $diffpos -= $posval;
         } else {
            $diffpos = 0;
         }
         ###$retrel = substr( $target, $posval+1, length( $target ) );
         prt( "Return substr of target, from ".($posval+1).", for $diffpos length ...\n" ) if ($dbg_rel2);
         ###$retrel = substr( $target, $posval+1, $diffpos );
         $retrel = substr( $target, ($posval+1) );
      } else {
         prt( "posval+1 (".($posval+1).") greater than length $diffpos ...\n" ) if ($dbg_rel2);
      }
   } else {
      # // find out how many "../"'s are necessary
      # // Step through the fromdir path, checking for slashes
      # // each slash encountered requires a "../"
      #$posval++;
      while ( substr($fromdir,$posval,1) ) {
         prt( "Check for slash ... $posval in $fromdir\n" ) if ($dbg_rel2);
         if ( substr($fromdir,$posval,1) eq "/" ) { # || ( substr($fromdir,$posval,1) eq "\\" ) ) {
            prt( "Found a slash, add a '../' \n" ) if ($dbg_rel2);
            $path .= "../";
         }
         $posval++;
      }
      prt( "Backed relative path = [$path] ...\n" ) if ($dbg_rel2);

      # // 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($target,$diffpos,1) ne "/" ) && substr($target,$diffpos,1) ) {
         $diffpos--;
      }
      # // Build relative path to return
      $retrel = $path . substr( $target, $diffpos+1, length( $target ) );
    }
   prt( "Returning [$retrel] ...\n" ) if ($dbg_rel2);
   return $retrel;
}


sub get_rel_dos_path {
   my ($targ, $from) = @_;
   my $rp = get_relative_path($targ, $from);
   $rp = path_u2d($rp);
   return $rp;
}

1;
# eof - relative.pl

index -|- top

checked by tidy  Valid HTML 4.01 Transitional