home *** CD-ROM | disk | FTP | other *** search
/ CLIX - Fazer Clix Custa Nix / CLIX-CD.cdr / mac / lib / URI / URL / gopher.pm < prev    next >
Encoding:
Perl POD Document  |  1997-01-27  |  2.0 KB  |  83 lines  |  [TEXT/McPL]
  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.     # not according to RFC1738, but many popular browsers accept
  35.     # gopher URLs with a '?' before the search string.
  36.     $p =~ s/\?/\t/;
  37.     $p = uri_unescape($p);
  38.  
  39.     if (defined($p) && $p ne '/' && $p =~ s!^/?(.)!!) {
  40.     $self->{'gtype'} = $1;
  41.     } else {
  42.     $self->{'gtype'} = "1";
  43.     $p = "";
  44.     }
  45.  
  46.     delete $self->{'selector'};
  47.     delete $self->{'search'};
  48.     delete $self->{'string'};
  49.  
  50.     my @parts = split(/\t/, $p, 3);
  51.     $self->{'selector'} = shift @parts if @parts;
  52.     $self->{'search'}   = shift @parts if @parts;
  53.     $self->{'string'}   = shift @parts if @parts;
  54. }
  55.  
  56.  
  57. sub gtype    { shift->_path_elem('gtype',    @_); }
  58. sub selector { shift->_path_elem('selector', @_); }
  59. sub search   { shift->_path_elem('search',   @_); }
  60. sub string   { shift->_path_elem('string',   @_); }
  61.  
  62. sub _path_elem {
  63.     my($self, $elem, @val) = @_;
  64.     my $old = $self->_elem($elem, @val);
  65.     return $old unless @val;
  66.  
  67.     # construct new path based on elements
  68.     my $path = "/$self->{'gtype'}";
  69.     $path .= "$self->{'selector'}" if defined $self->{'selector'};
  70.     $path .= "\t$self->{'search'}" if defined $self->{'search'};
  71.     $path .= "\t$self->{'string'}" if defined $self->{'string'};
  72.     $self->{'path'} = $path;
  73.  
  74.     $old;
  75. }
  76.  
  77. *params  = \&URI::URL::bad_method;
  78. *qparams = \&URI::URL::bad_method;
  79. *query   = \&URI::URL::bad_method;
  80. *equery  = \&URI::URL::bad_method;
  81.  
  82. 1;
  83.