home *** CD-ROM | disk | FTP | other *** search
/ isnet Internet / Isnet Internet CD.iso / prog / hiz / 09 / 09.exe / adynware.exe / perl / lib / site / URI / URL / mailto.pm < prev    next >
Encoding:
Perl POD Document  |  1999-12-28  |  1.6 KB  |  77 lines

  1. package URI::URL::mailto;
  2. require URI::URL;
  3. @ISA = qw(URI::URL);
  4.  
  5. use URI::Escape;
  6.  
  7. sub new {
  8.     my($class, $init, $base) = @_;
  9.  
  10.     my $self = bless { }, $class;
  11.     $self->{'scheme'} = lc($1) if $init =~ s/^\s*([\w\+\.\-]+)://;
  12.     $self->{'address'} = uri_unescape($init);
  13.     $self->base($base) if $base;
  14.     $self;
  15. }
  16.  
  17. sub address { shift->_elem('address', @_); }
  18.  
  19. *encoded822addr = \&address;   # URI::URL v3 compatibility
  20. *netloc         = \&address;
  21.  
  22. sub user {
  23.     my $self = shift;
  24.     $old = $self->{'address'};
  25.     if (@_) {
  26.     my $new = $old;
  27.     $new =~ s/.*\@?/$_[0]\@/;
  28.     $self->{'address'} = $new;
  29.     }
  30.     $old =~ s/\@.*//;
  31.     $old;
  32. }
  33.  
  34. sub host {
  35.     my $self = shift;
  36.     $old = $self->{'address'};
  37.     if (@_) {
  38.     my $new = $old;
  39.     $new =~ s/\@.*/\@$_[0]/;
  40.     $self->{'address'} = $new;
  41.     }
  42.     $old =~ s/.*\@//;
  43.     $old;
  44. }
  45.  
  46. sub crack
  47. {
  48.     my $self = shift;
  49.     ('mailto',           # scheme
  50.      $self->user,        # user
  51.      undef,              # passwd
  52.      $self->host,        # host
  53.      undef,              # port
  54.      $self->{'address'}, # path
  55.      undef,              # params
  56.      undef,              # query
  57.      undef               # fragment
  58.     )
  59. }
  60.  
  61. sub as_string {
  62.     my $self = shift;
  63.     my $str = ($self->{'scheme'} || "mailto") . ":";
  64.     $str .= uri_escape($self->{'address'}) if defined $self->{'address'};
  65.     $str;
  66. }
  67.  
  68. sub eq {
  69.     my($self, $other) = @_;
  70.     $other = URI::URL->new($other) unless ref $other;
  71.  
  72.     $self->scheme eq $other->scheme &&
  73.       lc($self->{'address'}) eq lc($other->{'address'});
  74. }
  75.  
  76. 1;
  77.