X-Git-Url: http://git.maemo.org/git/?p=dh-make-perl;a=blobdiff_plain;f=dev%2Farm%2Fliburi-perl%2Fliburi-perl-1.35.dfsg.1%2FURI%2Fgopher.pm;fp=dev%2Farm%2Fliburi-perl%2Fliburi-perl-1.35.dfsg.1%2FURI%2Fgopher.pm;h=ae6690423bc4fe37aa1fc2ad5e9155b2085d10ba;hp=0000000000000000000000000000000000000000;hb=f477fa73365d491991707e7ed9217b48d6994551;hpb=da95c414033799c3a62606f299c3c00b5c77ca11 diff --git a/dev/arm/liburi-perl/liburi-perl-1.35.dfsg.1/URI/gopher.pm b/dev/arm/liburi-perl/liburi-perl-1.35.dfsg.1/URI/gopher.pm new file mode 100644 index 0000000..ae66904 --- /dev/null +++ b/dev/arm/liburi-perl/liburi-perl-1.35.dfsg.1/URI/gopher.pm @@ -0,0 +1,94 @@ +package URI::gopher; # , Dec 4, 1996 + +require URI::_server; +@ISA=qw(URI::_server); + +use strict; +use URI::Escape qw(uri_unescape); + +# A Gopher URL follows the common internet scheme syntax as defined in +# section 4.3 of [RFC-URL-SYNTAX]: +# +# gopher://[:]/ +# +# where +# +# := | +# %09 | +# %09%09 +# +# := '0' | '1' | '2' | '3' | '4' | '5' | '6' | '7' +# '8' | '9' | '+' | 'I' | 'g' | 'T' +# +# := *pchar Refer to RFC 1808 [4] +# := *pchar +# := *uchar Refer to RFC 1738 [3] +# +# If the optional port is omitted, the port defaults to 70. + +sub default_port { 70 } + +sub _gopher_type +{ + my $self = shift; + my $path = $self->path_query; + $path =~ s,^/,,; + my $gtype = $1 if $path =~ s/^(.)//s; + if (@_) { + my $new_type = shift; + if (defined($new_type)) { + Carp::croak("Bad gopher type '$new_type'") + unless length($new_type) == 1; + substr($path, 0, 0) = $new_type; + $self->path_query($path); + } else { + Carp::croak("Can't delete gopher type when selector is present") + if length($path); + $self->path_query(undef); + } + } + return $gtype; +} + +sub gopher_type +{ + my $self = shift; + my $gtype = $self->_gopher_type(@_); + $gtype = "1" unless defined $gtype; + $gtype; +} + +*gtype = \&gopher_type; # URI::URL compatibility + +sub selector { shift->_gfield(0, @_) } +sub search { shift->_gfield(1, @_) } +sub string { shift->_gfield(2, @_) } + +sub _gfield +{ + my $self = shift; + my $fno = shift; + my $path = $self->path_query; + + # not according to spec., but many popular browsers accept + # gopher URLs with a '?' before the search string. + $path =~ s/\?/\t/; + $path = uri_unescape($path); + $path =~ s,^/,,; + my $gtype = $1 if $path =~ s,^(.),,s; + my @path = split(/\t/, $path, 3); + if (@_) { + # modify + my $new = shift; + $path[$fno] = $new; + pop(@path) while @path && !defined($path[-1]); + for (@path) { $_="" unless defined } + $path = $gtype; + $path = "1" unless defined $path; + $path .= join("\t", @path); + $self->path_query($path); + } + $path[$fno]; +} + +1;