1package URI::gopher; # <draft-murali-url-gopher>, Dec 4, 1996 2 3require URI::_server; 4@ISA=qw(URI::_server); 5 6use strict; 7use 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 29sub default_port { 70 } 30 31sub _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 length($new_type) == 1; 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 53sub 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 63sub selector { shift->_gfield(0, @_) } 64sub search { shift->_gfield(1, @_) } 65sub string { shift->_gfield(2, @_) } 66 67sub _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 941; 95