home *** CD-ROM | disk | FTP | other *** search
/ Chip 2000 May / Chip_2000-05_cd1.bin / zkuste / Perl / ActivePerl-5.6.0.613.msi / 䆊䌷䈹䈙䏵-䞅䞆䞀㡆䞃䄦䠥 / _df79f63aef5cea4f129eee34b3c6852e < prev    next >
Encoding:
Text File  |  2000-03-15  |  2.4 KB  |  95 lines
  1. package URI::gopher;  # <draft-murali-url-gopher>, Dec 4, 1996
  2.  
  3. require URI::_server;
  4. @ISA=qw(URI::_server);
  5.  
  6. use strict;
  7. use URI::Escape qw(uri_unescape);
  8.  
  9. #  A Gopher URL follows the common internet scheme syntax as defined in 
  10. #  section 4.3 of [RFC-URL-SYNTAX]:
  11. #
  12. #        gopher://<host>[:<port>]/<gopher-path>
  13. #
  14. #  where
  15. #
  16. #        <gopher-path> :=  <gopher-type><selector> | 
  17. #                          <gopher-type><selector>%09<search> |
  18. #                          <gopher-type><selector>%09<search>%09<gopher+_string>
  19. #
  20. #        <gopher-type> := '0' | '1' | '2' | '3' | '4' | '5' | '6' | '7'
  21. #                         '8' | '9' | '+' | 'I' | 'g' | 'T'
  22. #
  23. #        <selector>    := *pchar     Refer to RFC 1808 [4]
  24. #        <search>      := *pchar
  25. #        <gopher+_string> := *uchar  Refer to RFC 1738 [3]
  26. #        
  27. #  If the optional port is omitted, the port defaults to 70. 
  28.  
  29. sub default_port { 70 }
  30.  
  31. sub _gopher_type
  32. {
  33.     my $self = shift;
  34.     my $path = $self->path_query;
  35.     $path =~ s,^/,,;
  36.     my $gtype = $1 if $path =~ s/^(.)//s;
  37.     if (@_) {
  38.     my $new_type = shift;
  39.     if (defined($new_type)) {
  40.         Carp::croak("Bad gopher type '$new_type'")
  41.                unless $new_type =~ /^[0-9+IgT]$/;
  42.         substr($path, 0, 0) = $new_type;
  43.         $self->path_query($path);
  44.     } else {
  45.         Carp::croak("Can't delete gopher type when selector is present")
  46.         if length($path);
  47.         $self->path_query(undef);
  48.     }
  49.     }
  50.     return $gtype;
  51. }
  52.  
  53. sub gopher_type
  54. {
  55.     my $self = shift;
  56.     my $gtype = $self->_gopher_type(@_);
  57.     $gtype = "1" unless defined $gtype;
  58.     $gtype;
  59. }
  60.  
  61. *gtype = \&gopher_type;  # URI::URL compatibility
  62.  
  63. sub selector { shift->_gfield(0, @_) }
  64. sub search   { shift->_gfield(1, @_) }
  65. sub string   { shift->_gfield(2, @_) }
  66.  
  67. sub _gfield
  68. {
  69.     my $self = shift;
  70.     my $fno  = shift;
  71.     my $path = $self->path_query;
  72.  
  73.     # not according to spec., but many popular browsers accept
  74.     # gopher URLs with a '?' before the search string.
  75.     $path =~ s/\?/\t/;
  76.     $path = uri_unescape($path);
  77.     $path =~ s,^/,,;
  78.     my $gtype = $1 if $path =~ s,^(.),,s;
  79.     my @path = split(/\t/, $path, 3);
  80.     if (@_) {
  81.     # modify
  82.     my $new = shift;
  83.     $path[$fno] = $new;
  84.     pop(@path) while @path && !defined($path[-1]);
  85.     for (@path) { $_="" unless defined }
  86.     $path = $gtype;
  87.     $path = "1" unless defined $path;
  88.     $path .= join("\t", @path);
  89.     $self->path_query($path);
  90.     }
  91.     $path[$fno];
  92. }
  93.  
  94. 1;
  95.