home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / perl_ste.zip / auto / URI / URL / _generic / eq.al < prev    next >
Text File  |  1997-11-28  |  1KB  |  35 lines
  1. # NOTE: Derived from ./blib/lib/URI/URL/_generic.pm.  Changes made here will be lost.
  2. package URI::URL::_generic;
  3.  
  4. # Compare two URLs
  5. sub eq {
  6.     my($self, $other) = @_;
  7.     local($^W) = 0; # avoid warnings if we compare undef values
  8.     $other = URI::URL->new($other, $self) unless ref $other;
  9.  
  10.     # Compare scheme and netloc
  11.     return 0 if ref($self) ne ref($other);                # must be same class
  12.     return 0 if $self->scheme ne $other->scheme;          # Always lower case
  13.     return 0 if lc($self->netloc) ne lc($other->netloc);  # Case-insensitive
  14.  
  15.     # Compare full_path:
  16.     # According to <draft-ietf-http-v11-spec-05>:
  17.     # Characters other than those in the "reserved" and "unsafe" sets
  18.     # are equivalent to their %XX encodings.
  19.     my $fp1 = $self->full_path;
  20.     my $fp2 = $other->full_path;
  21.     for ($fp1, $fp2) {
  22.     s,%([\dA-Fa-f]{2}),
  23.       my $x = $1;
  24.       my $c = chr(hex($x));
  25.       $c =~ /^[;\/?:\@&=+\"\#%<>\0-\040\177]/ ? "%\L$x" : $c;
  26.     ,eg;
  27.     }
  28.     return 0 if $fp1 ne $fp2;
  29.     return 0 if $self->frag ne $other->frag;
  30.     1;
  31. }
  32.  
  33. 1;
  34. 1;
  35.