fixed URI::URL rel

Thomas J. Popovich (tpop@zso.dec.com)
Sat, 15 Aug 1998 21:50:23 -0700 

$r2 = new URI::URL
  'http://www.zc.com/AddingSecurityIntoM2.html#Figure1',
  'http://www.zc.com/~foo/security/Adding.html#Figure1';
print $r2->rel, "\n";

will print out ../../AddingSecurityIntoM2.html#Figure1

I think that this should NOT map to ../../XXX  since you don't know
where/what ~foo maps to.  This should stay mapped to:
 http://www.zc.com/AddingSecurityIntoM2.html.

=======================================
its fixed in the following code

package URI::URL::_generic;

# The oposite of $url->abs.  Return a URL as much relative as possible
sub rel {
    my($self, $base) = @_;
    my $rel = $self->clone;
    $base = $self->base unless $base;
    return $rel unless $base;
    $base = new URI::URL $base unless ref $base;
    $rel->base($base);

    my($scheme, $netloc, $path) = @{$rel}{qw(scheme netloc path)};
    if (!defined($scheme) && !defined($netloc)) {
	# it is already relative
	return $rel;
    }

    my($bscheme, $bnetloc, $bpath) = @{$base}{qw(scheme netloc path)};
    for ($bscheme, $bnetloc, $netloc) { $_ = '' unless defined }

    unless ($scheme eq $bscheme && $netloc eq $bnetloc) {
	# different location, can't make it relative
	return $rel;
    }

    ## if you have 2 paths to compare like 
    ## $bpath=/~foo/security/Adding.html  and $path=/AddingSecurityIntoM2.html
    ## the original rel would return 'a relative path path'
    ## of => '../../AddingSecurityIntoM2.html'
    ## The following code will cause an absolute path to be returned instead
    return $rel
      if (($bpath =~ m, ^ (?# start of path) /~ (?# then / & ~) ,x)
       || (path  =~ m, ^ (?# start of path) /~ (?# then / & ~) ,x)) ;

    for ($path, $bpath) {  $_ = "/$_" unless m,^/,; }

    # Make it relative by eliminating scheme and netloc
    $rel->{'scheme'} = undef;
    $rel->netloc(undef);

    # This loop is based on code from Nicolai Langfeldt <janl@ifi.uio.no>.
    # First we calculate common initial path components length ($li).
    my $li = 1;
    while (1) {
	my $i = index($path, '/', $li);
	last if $i < 0 ||
                $i != index($bpath, '/', $li) ||
	        substr($path,$li,$i-$li) ne substr($bpath,$li,$i-$li);
	$li=$i+1;
    }
    # then we nuke it from both paths
    substr($path, 0,$li) = '';
    substr($bpath,0,$li) = '';

    if ($path eq $bpath && defined($rel->frag) && !defined($rel->equery)) {
        $rel->epath('');
    } else {
        # Add one "../" for each path component left in the base path
        $path = ('../' x $bpath =~ tr|/|/|) . $path;
	$path = "./" if $path eq "";
        $rel->epath($path);
    }

    $rel;
}