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;
|
---|