Commit | Line | Data |
3fea05b9 |
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 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 | |
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; |