home *** CD-ROM | disk | FTP | other *** search
/ CLIX - Fazer Clix Custa Nix / CLIX-CD.cdr / mac / lib / auto / URI / URL / _generic / rel.al < prev    next >
Encoding:
Text File  |  1997-06-10  |  1.5 KB  |  50 lines  |  [TEXT/McPL]
  1. # NOTE: Derived from ./blib/lib/URI/URL/_generic.pm.  Changes made here will be lost.
  2. package URI::URL::_generic;
  3.  
  4. # The oposite of $url->abs.  Return a URL as much relative as possible
  5. sub rel {
  6.     my($self, $base) = @_;
  7.     my $rel = $self->clone;
  8.     $base = $self->base unless $base;
  9.     return $rel unless $base;
  10.     $base = new URI::URL $base unless ref $base;
  11.     $rel->base($base);
  12.  
  13.     my($scheme, $netloc, $path) = @{$rel}{qw(scheme netloc path)};
  14.     if (!defined($scheme) && !defined($netloc)) {
  15.     # it is already relative
  16.     return $rel;
  17.     }
  18.     
  19.     my($bscheme, $bnetloc, $bpath) = @{$base}{qw(scheme netloc path)};
  20.     for ($netloc, $bnetloc, $bpath) { $_ = '' unless defined }
  21.     $bpath = "/" unless length $bpath;  # a slash is default
  22.     unless ($scheme eq $bscheme && $netloc eq $bnetloc) {
  23.     # different location, can't make it relative
  24.     return $rel;
  25.     }
  26.  
  27.     # Make it relative by eliminating scheme and netloc
  28.     $rel->{'scheme'} = undef;
  29.     $rel->netloc(undef);
  30.  
  31.     # This loop is based on code from Nicolai Langfeldt <janl@ifi.uio.no>.
  32.     # It will remove all common initial path components.
  33.     while (1) {
  34.     #print "PATHS: $path $bpath\n";
  35.     my $i = index($path, '/');
  36.     last unless $i >=0 && $i == index($bpath, '/') &&
  37.                     substr($path,0,$i) eq substr($bpath,0,$i);
  38.     substr($path, 0, $i+1)  = '';
  39.     substr($bpath, 0, $i+1) = '';
  40.     }
  41.  
  42.     # Add one "../" for each path component left in the base path
  43.     $path = ('../' x $bpath =~ tr|/|/|) . $path;
  44.  
  45.     $rel->epath($path);
  46.     $rel;
  47. }
  48.  
  49. 1;
  50.