1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
|
package URI::URL::gopher;
require URI::URL::_generic;
@ISA = qw(URI::URL::_generic);
use URI::Escape qw(uri_unescape);
sub default_port { 70 }
sub _parse {
my($self, $init) = @_;
$self->URI::URL::_generic::_parse($init, qw(netloc path));
$self->_parse_gopherpath;
}
sub path {
my $self = shift;
my $old = $self->URI::URL::_generic::path(@_);
return $old unless @_;
$self->_parse_gopherpath;
$old;
}
sub epath {
my $self = shift;
my $old = $self->URI::URL::_generic::epath(@_);
return $old unless @_;
$self->_parse_gopherpath;
$old;
}
sub _parse_gopherpath {
my $self = shift;
my $p = $self->{'path'};
# not according to RFC1738, but many popular browsers accept
# gopher URLs with a '?' before the search string.
$p =~ s/\?/\t/;
$p = uri_unescape($p);
if (defined($p) && $p ne '/' && $p =~ s!^/?(.)!!) {
$self->{'gtype'} = $1;
} else {
$self->{'gtype'} = "1";
$p = "";
}
delete $self->{'selector'};
delete $self->{'search'};
delete $self->{'string'};
my @parts = split(/\t/, $p, 3);
$self->{'selector'} = shift @parts if @parts;
$self->{'search'} = shift @parts if @parts;
$self->{'string'} = shift @parts if @parts;
}
sub gtype { shift->_path_elem('gtype', @_); }
sub selector { shift->_path_elem('selector', @_); }
sub search { shift->_path_elem('search', @_); }
sub string { shift->_path_elem('string', @_); }
sub _path_elem {
my($self, $elem, @val) = @_;
my $old = $self->_elem($elem, @val);
return $old unless @val;
# construct new path based on elements
my $path = "/$self->{'gtype'}";
$path .= "$self->{'selector'}" if defined $self->{'selector'};
$path .= "\t$self->{'search'}" if defined $self->{'search'};
$path .= "\t$self->{'string'}" if defined $self->{'string'};
$self->{'path'} = $path;
$old;
}
*params = \&URI::URL::bad_method;
*qparams = \&URI::URL::bad_method;
*query = \&URI::URL::bad_method;
*equery = \&URI::URL::bad_method;
1;
|
