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 / gopher.pm < prev    next >
Encoding:
Perl POD Document  |  1999-12-28  |  1.9 KB  |  80 lines
  1. package URI::URL::gopher;
  2. require URI::URL::_generic;
  3. @ISA = qw(URI::URL::_generic);
  4.  
  5. use URI::Escape qw(uri_unescape);
  6.  
  7. sub default_port { 70 }
  8.  
  9. sub _parse {
  10.     my($self, $init)   = @_;
  11.     $self->URI::URL::_generic::_parse($init, qw(netloc path));
  12.     $self->_parse_gopherpath;
  13. }
  14.  
  15. sub path {
  16.     my $self = shift;
  17.     my $old = $self->URI::URL::_generic::path(@_);
  18.     return $old unless @_;
  19.     $self->_parse_gopherpath;
  20.     $old;
  21. }
  22.  
  23. sub epath {
  24.     my $self = shift;
  25.     my $old = $self->URI::URL::_generic::epath(@_);
  26.     return $old unless @_;
  27.     $self->_parse_gopherpath;
  28.     $old;
  29. }
  30.  
  31. sub _parse_gopherpath {
  32.     my $self = shift;
  33.     my $p = $self->{'path'};
  34.     $p =~ s/\?/\t/;
  35.     $p = uri_unescape($p);
  36.  
  37.     if (defined($p) && $p ne '/' && $p =~ s!^/?(.)!!) {
  38.     $self->{'gtype'} = $1;
  39.     } else {
  40.     $self->{'gtype'} = "1";
  41.     $p = "";
  42.     }
  43.  
  44.     delete $self->{'selector'};
  45.     delete $self->{'search'};
  46.     delete $self->{'string'};
  47.  
  48.     my @parts = split(/\t/, $p, 3);
  49.     $self->{'selector'} = shift @parts if @parts;
  50.     $self->{'search'}   = shift @parts if @parts;
  51.     $self->{'string'}   = shift @parts if @parts;
  52. }
  53.  
  54.  
  55. sub gtype    { shift->_path_elem('gtype',    @_); }
  56. sub selector { shift->_path_elem('selector', @_); }
  57. sub search   { shift->_path_elem('search',   @_); }
  58. sub string   { shift->_path_elem('string',   @_); }
  59.  
  60. sub _path_elem {
  61.     my($self, $elem, @val) = @_;
  62.     my $old = $self->_elem($elem, @val);
  63.     return $old unless @val;
  64.  
  65.     my $path = "/$self->{'gtype'}";
  66.     $path .= "$self->{'selector'}" if defined $self->{'selector'};
  67.     $path .= "\t$self->{'search'}" if defined $self->{'search'};
  68.     $path .= "\t$self->{'string'}" if defined $self->{'string'};
  69.     $self->{'path'} = $path;
  70.  
  71.     $old;
  72. }
  73.  
  74. *params  = \&URI::URL::bad_method;
  75. *qparams = \&URI::URL::bad_method;
  76. *query   = \&URI::URL::bad_method;
  77. *equery  = \&URI::URL::bad_method;
  78.  
  79. 1;
  80.