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