diff options
author | Norbert Preining <norbert@preining.info> | 2024-03-15 03:06:35 +0000 |
---|---|---|
committer | Norbert Preining <norbert@preining.info> | 2024-03-15 03:06:35 +0000 |
commit | 12679ab7d3c2a210f4123163671b532b8b55d5f9 (patch) | |
tree | 0060d13467186ad977f4e73488ee20dd6c0017ab /systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI | |
parent | 62170822e034fdd3f81de7274835d0d3b0467100 (diff) |
CTAN sync 202403150306
Diffstat (limited to 'systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI')
56 files changed, 829 insertions, 302 deletions
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/Escape.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/Escape.pm index 5760bb55b0..c784c81fe0 100644 --- a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/Escape.pm +++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/Escape.pm @@ -71,6 +71,13 @@ as the reserved characters. I.e. the default is: "^A-Za-z0-9\-\._~" +The second argument can also be specified as a regular expression object: + + qr/[^A-Za-z]/ + +Any strings matched by this regular expression will have all of their +characters escaped. + =item uri_escape_utf8( $string ) =item uri_escape_utf8( $string, $unsafe ) @@ -141,7 +148,7 @@ use Exporter 5.57 'import'; our %escapes; our @EXPORT = qw(uri_escape uri_unescape uri_escape_utf8); our @EXPORT_OK = qw(%escapes); -our $VERSION = '5.10'; +our $VERSION = '5.27'; use Carp (); @@ -160,17 +167,37 @@ my %Unsafe = ( sub uri_escape { my($text, $patn) = @_; return undef unless defined $text; + my $re; if (defined $patn){ - unless (exists $subst{$patn}) { - # Because we can't compile the regex we fake it with a cached sub - (my $tmp = $patn) =~ s,/,\\/,g; - eval "\$subst{\$patn} = sub {\$_[0] =~ s/([$tmp])/\$escapes{\$1} || _fail_hi(\$1)/ge; }"; - Carp::croak("uri_escape: $@") if $@; + if (ref $patn eq 'Regexp') { + $text =~ s{($patn)}{ + join('', map +($escapes{$_} || _fail_hi($_)), split //, "$1") + }ge; + return $text; } - &{$subst{$patn}}($text); - } else { - $text =~ s/($Unsafe{RFC3986})/$escapes{$1} || _fail_hi($1)/ge; + $re = $subst{$patn}; + if (!defined $re) { + $re = $patn; + # we need to escape the [] characters, except for those used in + # posix classes. if they are prefixed by a backslash, allow them + # through unmodified. + $re =~ s{(\[:\w+:\])|(\\)?([\[\]]|\\\z)}{ + defined $1 ? $1 : defined $2 ? "$2$3" : "\\$3" + }ge; + eval { + # disable the warnings here, since they will trigger later + # when used, and we only want them to appear once per call, + # but every time the same pattern is used. + no warnings 'regexp'; + $re = $subst{$patn} = qr{[$re]}; + 1; + } or Carp::croak("uri_escape: $@"); + } + } + else { + $re = $Unsafe{RFC3986}; } + $text =~ s/($re)/$escapes{$1} || _fail_hi($1)/ge; $text; } diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/Heuristic.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/Heuristic.pm index f2637a028b..bc775a53bc 100644 --- a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/Heuristic.pm +++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/Heuristic.pm @@ -91,7 +91,7 @@ use warnings; use Exporter 5.57 'import'; our @EXPORT_OK = qw(uf_uri uf_uristr uf_url uf_urlstr); -our $VERSION = '5.10'; +our $VERSION = '5.27'; our ($MY_COUNTRY, $DEBUG); diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/IRI.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/IRI.pm index fd185a9e49..f62c77bdd5 100644 --- a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/IRI.pm +++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/IRI.pm @@ -8,7 +8,7 @@ use URI (); use overload '""' => sub { shift->as_string }; -our $VERSION = '5.10'; +our $VERSION = '5.27'; sub new { my($class, $uri, $scheme) = @_; diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/QueryParam.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/QueryParam.pm index c7ff25ed9f..de3c54cf18 100644 --- a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/QueryParam.pm +++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/QueryParam.pm @@ -1,90 +1,8 @@ package URI::QueryParam; - use strict; use warnings; -our $VERSION = '5.10'; - -sub URI::_query::query_param { - my $self = shift; - my @old = $self->query_form; - - if (@_ == 0) { - # get keys - my (%seen, $i); - return grep !($i++ % 2 || $seen{$_}++), @old; - } - - my $key = shift; - my @i = grep $_ % 2 == 0 && $old[$_] eq $key, 0 .. $#old; - - if (@_) { - my @new = @old; - my @new_i = @i; - my @vals = map { ref($_) eq 'ARRAY' ? @$_ : $_ } @_; - - while (@new_i > @vals) { - splice @new, pop @new_i, 2; - } - if (@vals > @new_i) { - my $i = @new_i ? $new_i[-1] + 2 : @new; - my @splice = splice @vals, @new_i, @vals - @new_i; - - splice @new, $i, 0, map { $key => $_ } @splice; - } - if (@vals) { - #print "SET $new_i[0]\n"; - @new[ map $_ + 1, @new_i ] = @vals; - } - - $self->query_form(\@new); - } - - return wantarray ? @old[map $_+1, @i] : @i ? $old[$i[0]+1] : undef; -} - -sub URI::_query::query_param_append { - my $self = shift; - my $key = shift; - my @vals = map { ref $_ eq 'ARRAY' ? @$_ : $_ } @_; - $self->query_form($self->query_form, $key => \@vals); # XXX - return; -} - -sub URI::_query::query_param_delete { - my $self = shift; - my $key = shift; - my @old = $self->query_form; - my @vals; - - for (my $i = @old - 2; $i >= 0; $i -= 2) { - next if $old[$i] ne $key; - push(@vals, (splice(@old, $i, 2))[1]); - } - $self->query_form(\@old) if @vals; - return wantarray ? reverse @vals : $vals[-1]; -} - -sub URI::_query::query_form_hash { - my $self = shift; - my @old = $self->query_form; - if (@_) { - $self->query_form(@_ == 1 ? %{shift(@_)} : @_); - } - my %hash; - while (my($k, $v) = splice(@old, 0, 2)) { - if (exists $hash{$k}) { - for ($hash{$k}) { - $_ = [$_] unless ref($_) eq "ARRAY"; - push(@$_, $v); - } - } - else { - $hash{$k} = $v; - } - } - return \%hash; -} +our $VERSION = '5.27'; 1; @@ -97,108 +15,16 @@ URI::QueryParam - Additional query methods for URIs =head1 SYNOPSIS use URI; - use URI::QueryParam; - - $u = URI->new("", "http"); - $u->query_param(foo => 1, 2, 3); - print $u->query; # prints foo=1&foo=2&foo=3 - - for my $key ($u->query_param) { - print "$key: ", join(", ", $u->query_param($key)), "\n"; - } =head1 DESCRIPTION -Loading the C<URI::QueryParam> module adds some extra methods to -URIs that support query methods. These methods provide an alternative -interface to the $u->query_form data. - -The query_param_* methods have deliberately been made identical to the -interface of the corresponding C<CGI.pm> methods. - -The following additional methods are made available: - -=over - -=item @keys = $u->query_param - -=item @values = $u->query_param( $key ) - -=item $first_value = $u->query_param( $key ) - -=item $u->query_param( $key, $value,... ) - -If $u->query_param is called with no arguments, it returns all the -distinct parameter keys of the URI. In a scalar context it returns the -number of distinct keys. - -When a $key argument is given, the method returns the parameter values with the -given key. In a scalar context, only the first parameter value is -returned. - -If additional arguments are given, they are used to update successive -parameters with the given key. If any of the values provided are -array references, then the array is dereferenced to get the actual -values. - -Please note that you can supply multiple values to this method, but you cannot -supply multiple keys. - -Do this: - - $uri->query_param( widget_id => 1, 5, 9 ); - -Do NOT do this: - - $uri->query_param( widget_id => 1, frobnicator_id => 99 ); - -=item $u->query_param_append($key, $value,...) - -Adds new parameters with the given -key without touching any old parameters with the same key. It -can be explained as a more efficient version of: - - $u->query_param($key, - $u->query_param($key), - $value,...); - -One difference is that this expression would return the old values -of $key, whereas the query_param_append() method does not. - -=item @values = $u->query_param_delete($key) - -=item $first_value = $u->query_param_delete($key) - -Deletes all key/value pairs with the given key. -The old values are returned. In a scalar context, only the first value -is returned. - -Using the query_param_delete() method is slightly more efficient than -the equivalent: - - $u->query_param($key, []); - -=item $hashref = $u->query_form_hash - -=item $u->query_form_hash( \%new_form ) - -Returns a reference to a hash that represents the -query form's key/value pairs. If a key occurs multiple times, then the hash -value becomes an array reference. - -Note that sequence information is lost. This means that: - - $u->query_form_hash($u->query_form_hash); - -is not necessarily a no-op, as it may reorder the key/value pairs. -The values returned by the query_param() method should stay the same -though. - -=back - -=head1 SEE ALSO - -L<URI>, L<CGI> +C<URI::QueryParam> used to provide the +L<< query_form_hash|URI/$hashref = $u->query_form_hash >>, +L<< query_param|URI/@keys = $u->query_param >> +L<< query_param_append|URI/$u->query_param_append($key, $value,...) >>, and +L<< query_param_delete|URI/ @values = $u->query_param_delete($key) >> methods +on L<URI> objects. These methods have been merged into L<URI> itself, so this +module is now a no-op. =head1 COPYRIGHT diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/Split.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/Split.pm index b31d8281ce..9ac3b15eaf 100644 --- a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/Split.pm +++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/Split.pm @@ -3,7 +3,7 @@ package URI::Split; use strict; use warnings; -our $VERSION = '5.10'; +our $VERSION = '5.27'; use Exporter 5.57 'import'; our @EXPORT_OK = qw(uri_split uri_join); diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/URL.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/URL.pm index 9591e9e76a..1b88311af4 100644 --- a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/URL.pm +++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/URL.pm @@ -5,7 +5,7 @@ use warnings; use parent 'URI::WithBase'; -our $VERSION = '5.10'; +our $VERSION = '5.27'; # Provide as much as possible of the old URI::URL interface for backwards # compatibility... diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/WithBase.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/WithBase.pm index 76c331b0af..29e76d4b2f 100644 --- a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/WithBase.pm +++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/WithBase.pm @@ -6,7 +6,7 @@ use warnings; use URI (); use Scalar::Util qw(blessed); -our $VERSION = '5.10'; +our $VERSION = '5.27'; use overload '""' => "as_string", fallback => 1; diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/_foreign.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/_foreign.pm index bc44f4a059..7225450b19 100644 --- a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/_foreign.pm +++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/_foreign.pm @@ -5,6 +5,6 @@ use warnings; use parent 'URI::_generic'; -our $VERSION = '5.10'; +our $VERSION = '5.27'; 1; diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/_generic.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/_generic.pm index 9ff33b2142..50bc7d27df 100644 --- a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/_generic.pm +++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/_generic.pm @@ -8,13 +8,33 @@ use parent qw(URI URI::_query); use URI::Escape qw(uri_unescape); use Carp (); -our $VERSION = '5.10'; +our $VERSION = '5.27'; -my $ACHAR = $URI::uric; $ACHAR =~ s,\\[/?],,g; -my $PCHAR = $URI::uric; $PCHAR =~ s,\\[?],,g; +my $ACHAR = URI::HAS_RESERVED_SQUARE_BRACKETS ? $URI::uric : $URI::uric4host; $ACHAR =~ s,\\[/?],,g; +my $PCHAR = $URI::uric; $PCHAR =~ s,\\[?],,g; sub _no_scheme_ok { 1 } +our $IPv6_re; + +sub _looks_like_raw_ip6_address { + my $addr = shift; + + if ( !$IPv6_re ) { #-- lazy / runs once / use Regexp::IPv6 if installed + eval { + require Regexp::IPv6; + Regexp::IPv6->import( qw($IPv6_re) ); + 1; + } || do { $IPv6_re = qr/[:0-9a-f]{3,}/; }; #-- fallback: unambitious guess + } + + return 0 unless $addr; + return 0 if $addr =~ tr/:/:/ < 2; #-- fallback must not create false positive for IPv4:Port = 0:0 + return 1 if $addr =~ /^$IPv6_re$/i; + return 0; +} + + sub authority { my $self = shift; @@ -26,6 +46,13 @@ sub authority my $rest = $3; if (defined $auth) { $auth =~ s/([^$ACHAR])/ URI::Escape::escape_char($1)/ego; + if ( my ($user, $host) = $auth =~ /^(.*@)?([^@]+)$/ ) { #-- special escape userinfo part + $user ||= ''; + $user =~ s/([^$URI::uric4user])/ URI::Escape::escape_char($1)/ego; + $user =~ s/%40$/\@/; # recover final '@' + $host = "[$host]" if _looks_like_raw_ip6_address( $host ); + $auth = $user . $host; + } utf8::downgrade($auth); $$self .= "//$auth"; } diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/_idna.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/_idna.pm index 4292d3e982..f36e937983 100644 --- a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/_idna.pm +++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/_idna.pm @@ -9,7 +9,7 @@ use warnings; use URI::_punycode qw(decode_punycode encode_punycode); use Carp qw(croak); -our $VERSION = '5.10'; +our $VERSION = '5.27'; BEGIN { *URI::_idna::_ENV_::JOIN_LEAKS_UTF8_FLAGS = "$]" < 5.008_003 diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/_ldap.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/_ldap.pm index 43193b4c9d..d2b943a79d 100644 --- a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/_ldap.pm +++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/_ldap.pm @@ -7,7 +7,7 @@ package URI::_ldap; use strict; use warnings; -our $VERSION = '5.10'; +our $VERSION = '5.27'; use URI::Escape qw(uri_unescape); diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/_login.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/_login.pm index c3d0583ccc..e930bf0886 100644 --- a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/_login.pm +++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/_login.pm @@ -5,7 +5,7 @@ use warnings; use parent qw(URI::_server URI::_userpass); -our $VERSION = '5.10'; +our $VERSION = '5.27'; # Generic terminal logins. This is used as a base class for 'telnet', # 'tn3270', and 'rlogin' URL schemes. diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/_punycode.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/_punycode.pm index eeb3662e1f..697c1b7bf6 100644 --- a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/_punycode.pm +++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/_punycode.pm @@ -3,7 +3,7 @@ package URI::_punycode; use strict; use warnings; -our $VERSION = '5.10'; +our $VERSION = '5.27'; use Exporter 'import'; our @EXPORT = qw(encode_punycode decode_punycode); @@ -25,7 +25,7 @@ my $BasicRE = qr/[\x00-\x7f]/; sub _croak { require Carp; Carp::croak(@_); } -sub digit_value { +sub _digit_value { my $code = shift; return ord($code) - ord("A") if $code =~ /[A-Z]/; return ord($code) - ord("a") if $code =~ /[a-z]/; @@ -33,14 +33,14 @@ sub digit_value { return; } -sub code_point { +sub _code_point { my $digit = shift; return $digit + ord('a') if 0 <= $digit && $digit <= 25; return $digit + ord('0') - 26 if 26 <= $digit && $digit <= 36; die 'NOT COME HERE'; } -sub adapt { +sub _adapt { my($delta, $numpoints, $firsttime) = @_; $delta = $firsttime ? $delta / DAMP : $delta / 2; $delta += $delta / $numpoints; @@ -71,7 +71,7 @@ sub decode_punycode { LOOP: for (my $k = BASE; 1; $k += BASE) { my $cp = substr($code, 0, 1, ''); - my $digit = digit_value($cp); + my $digit = _digit_value($cp); defined $digit or return _croak("invalid punycode input"); $i += $digit * $w; my $t = ($k <= $bias) ? TMIN @@ -79,7 +79,7 @@ sub decode_punycode { last LOOP if $digit < $t; $w *= (BASE - $t); } - $bias = adapt($i - $oldi, @output + 1, $oldi == 0); + $bias = _adapt($i - $oldi, @output + 1, $oldi == 0); warn "bias becomes $bias" if $DEBUG; $n += $i / (@output + 1); $i = $i % (@output + 1); @@ -106,7 +106,7 @@ sub encode_punycode { warn "basic codepoints: (@output)" if $DEBUG; while ($h < @input) { - my $m = min(grep { $_ >= $n } map ord, @input); + my $m = _min(grep { $_ >= $n } map ord, @input); warn sprintf "next code point to insert is %04x", $m if $DEBUG; $delta += ($m - $n) * ($h + 1); $n = $m; @@ -120,12 +120,12 @@ sub encode_punycode { my $t = ($k <= $bias) ? TMIN : ($k >= $bias + TMAX) ? TMAX : $k - $bias; last LOOP if $q < $t; - my $cp = code_point($t + (($q - $t) % (BASE - $t))); + my $cp = _code_point($t + (($q - $t) % (BASE - $t))); push @output, chr($cp); $q = ($q - $t) / (BASE - $t); } - push @output, chr(code_point($q)); - $bias = adapt($delta, $h + 1, $h == $b); + push @output, chr(_code_point($q)); + $bias = _adapt($delta, $h + 1, $h == $b); warn "bias becomes $bias" if $DEBUG; $delta = 0; $h++; @@ -137,7 +137,7 @@ sub encode_punycode { return join '', @output; } -sub min { +sub _min { my $min = shift; for (@_) { $min = $_ if $_ <= $min } return $min; diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/_query.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/_query.pm index b9b70c491d..f39f35749e 100644 --- a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/_query.pm +++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/_query.pm @@ -6,7 +6,7 @@ use warnings; use URI (); use URI::Escape qw(uri_unescape); -our $VERSION = '5.10'; +our $VERSION = '5.27'; sub query { @@ -51,10 +51,14 @@ sub query_form { $key =~ s/ /+/g; $vals = [ref($vals) eq "ARRAY" ? @$vals : $vals]; for my $val (@$vals) { - $val = '' unless defined $val; - $val =~ s/([;\/?:@&=+,\$\[\]%])/ URI::Escape::escape_char($1)/eg; - $val =~ s/ /+/g; - push(@query, "$key=$val"); + if (defined $val) { + $val =~ s/([;\/?:@&=+,\$\[\]%])/ URI::Escape::escape_char($1)/eg; + $val =~ s/ /+/g; + push(@query, "$key=$val"); + } + else { + push(@query, $key); + } } } if (@query) { @@ -70,8 +74,8 @@ sub query_form { } return if !defined($old) || !length($old) || !defined(wantarray); return unless $old =~ /=/; # not a form - map { s/\+/ /g; uri_unescape($_) } - map { /=/ ? split(/=/, $_, 2) : ($_ => '')} split(/[&;]/, $old); + map { ( defined ) ? do { s/\+/ /g; uri_unescape($_) } : undef } + map { /=/ ? split(/=/, $_, 2) : ($_ => undef)} split(/[&;]/, $old); } # Handle ...?dog+bones type of query @@ -94,4 +98,85 @@ sub query_keywords # Some URI::URL compatibility stuff sub equery { goto &query } +sub query_param { + my $self = shift; + my @old = $self->query_form; + + if (@_ == 0) { + # get keys + my (%seen, $i); + return grep !($i++ % 2 || $seen{$_}++), @old; + } + + my $key = shift; + my @i = grep $_ % 2 == 0 && $old[$_] eq $key, 0 .. $#old; + + if (@_) { + my @new = @old; + my @new_i = @i; + my @vals = map { ref($_) eq 'ARRAY' ? @$_ : $_ } @_; + + while (@new_i > @vals) { + splice @new, pop @new_i, 2; + } + if (@vals > @new_i) { + my $i = @new_i ? $new_i[-1] + 2 : @new; + my @splice = splice @vals, @new_i, @vals - @new_i; + + splice @new, $i, 0, map { $key => $_ } @splice; + } + if (@vals) { + #print "SET $new_i[0]\n"; + @new[ map $_ + 1, @new_i ] = @vals; + } + + $self->query_form(\@new); + } + + return wantarray ? @old[map $_+1, @i] : @i ? $old[$i[0]+1] : undef; +} + +sub query_param_append { + my $self = shift; + my $key = shift; + my @vals = map { ref $_ eq 'ARRAY' ? @$_ : $_ } @_; + $self->query_form($self->query_form, $key => \@vals); # XXX + return; +} + +sub query_param_delete { + my $self = shift; + my $key = shift; + my @old = $self->query_form; + my @vals; + + for (my $i = @old - 2; $i >= 0; $i -= 2) { + next if $old[$i] ne $key; + push(@vals, (splice(@old, $i, 2))[1]); + } + $self->query_form(\@old) if @vals; + return wantarray ? reverse @vals : $vals[-1]; +} + +sub query_form_hash { + my $self = shift; + my @old = $self->query_form; + if (@_) { + $self->query_form(@_ == 1 ? %{shift(@_)} : @_); + } + my %hash; + while (my($k, $v) = splice(@old, 0, 2)) { + if (exists $hash{$k}) { + for ($hash{$k}) { + $_ = [$_] unless ref($_) eq "ARRAY"; + push(@$_, $v); + } + } + else { + $hash{$k} = $v; + } + } + return \%hash; +} + 1; diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/_segment.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/_segment.pm index 364ca4857d..948e07b602 100644 --- a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/_segment.pm +++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/_segment.pm @@ -11,7 +11,7 @@ use URI::Escape qw(uri_unescape); use overload '""' => sub { $_[0]->[0] }, fallback => 1; -our $VERSION = '5.10'; +our $VERSION = '5.27'; sub new { diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/_server.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/_server.pm index fec55a4fe0..baaf8457bb 100644 --- a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/_server.pm +++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/_server.pm @@ -7,7 +7,7 @@ use parent 'URI::_generic'; use URI::Escape qw(uri_unescape); -our $VERSION = '5.10'; +our $VERSION = '5.27'; sub _uric_escape { my($class, $str) = @_; @@ -23,7 +23,8 @@ sub _uric_escape { } sub _host_escape { - return unless $_[0] =~ /[^$URI::uric]/; + return if URI::HAS_RESERVED_SQUARE_BRACKETS and $_[0] !~ /[^$URI::uric]/; + return if !URI::HAS_RESERVED_SQUARE_BRACKETS and $_[0] !~ /[^$URI::uric4host]/; eval { require URI::_idna; $_[0] = URI::_idna::encode($_[0]); @@ -59,8 +60,8 @@ sub userinfo $new =~ s/.*@//; # remove old stuff my $ui = shift; if (defined $ui) { - $ui =~ s/@/%40/g; # protect @ - $new = "$ui\@$new"; + $ui =~ s/([^$URI::uric4user])/ URI::Escape::escape_char($1)/ego; + $new = "$ui\@$new"; } $self->authority($new); } diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/_userpass.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/_userpass.pm index acf571783a..5fd36a78a2 100644 --- a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/_userpass.pm +++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/_userpass.pm @@ -5,7 +5,7 @@ use warnings; use URI::Escape qw(uri_unescape); -our $VERSION = '5.10'; +our $VERSION = '5.27'; sub user { @@ -39,8 +39,8 @@ sub password my $user = defined($info) ? $info : ""; $user =~ s/:.*//; - if (!defined($new) && !length($user)) { - $self->userinfo(undef); + if (!defined($new)) { + $self->userinfo(length $user ? $user : undef); } else { $new = "" unless defined($new); $new =~ s/%/%25/g; diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/data.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/data.pm index 666ef38afb..2b87018b46 100644 --- a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/data.pm +++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/data.pm @@ -5,7 +5,7 @@ use warnings; use parent 'URI'; -our $VERSION = '5.10'; +our $VERSION = '5.27'; use MIME::Base64 qw(decode_base64 encode_base64); use URI::Escape qw(uri_unescape); diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/file.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/file.pm index c9973ecce9..51f6431e8d 100644 --- a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/file.pm +++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/file.pm @@ -4,7 +4,7 @@ use strict; use warnings; use parent 'URI::_generic'; -our $VERSION = '5.10'; +our $VERSION = '5.27'; use URI::Escape qw(uri_unescape); @@ -113,13 +113,13 @@ URI::file - URI that maps to local file names =head1 SYNOPSIS use URI::file; - + $u1 = URI->new("file:/foo/bar"); $u2 = URI->new("foo/bar", "file"); - + $u3 = URI::file->new($path); $u4 = URI::file->new("c:\\windows\\", "win32"); - + $u1->file; $u1->file("mac"); @@ -127,10 +127,8 @@ URI::file - URI that maps to local file names The C<URI::file> class supports C<URI> objects belonging to the I<file> URI scheme. This scheme allows us to map the conventional file names -found on various computer systems to the URI name space. An old -specification of the I<file> URI scheme is found in RFC 1738. Some -older background information is also in RFC 1630. There are no newer -specifications as far as I know. +found on various computer systems to the URI name space, +see L<RFC 8089|https://www.rfc-editor.org/rfc/rfc8089.html>. If you simply want to construct I<file> URI objects from URI strings, use the normal C<URI> constructor. If you want to construct I<file> @@ -200,8 +198,9 @@ suitable for the local system: Most computer systems today have hierarchically organized file systems. Mapping the names used in these systems to the generic URI syntax allows us to work with relative file URIs that behave as they should -when resolved using the generic algorithm for URIs (specified in RFC -2396). Mapping a file name to the generic URI syntax involves mapping +when resolved using the generic algorithm for URIs (specified in L<RFC +3986|https://www.rfc-editor.org/rfc/rfc3986.html>). +Mapping a file name to the generic URI syntax involves mapping the path separator character to "/" and encoding any reserved characters that appear in the path segments of the file name. If path segments consisting of the strings "." or ".." have a @@ -301,11 +300,11 @@ If there is no mapping then the "Unix" implementation is used. =item $URI::file::DEFAULT_AUTHORITY -This determine what "authority" string to include in absolute file +This determines what "authority" string to include in absolute file URIs. It defaults to "". If you prefer verbose URIs you might set it to be "localhost". -Setting this value to C<undef> force behaviour compatible to URI v1.31 +Setting this value to C<undef> forces behaviour compatible to URI v1.31 and earlier. In this mode host names in UNC paths and drive letters are mapped to the authority component on Windows, while we produce authority-less URIs on Unix. diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/file/Base.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/file/Base.pm index 5192f33a14..993e6946d5 100644 --- a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/file/Base.pm +++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/file/Base.pm @@ -5,7 +5,7 @@ use warnings; use URI::Escape (); -our $VERSION = '5.10'; +our $VERSION = '5.27'; sub new { diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/file/FAT.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/file/FAT.pm index 521c3a05a4..98b651666e 100644 --- a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/file/FAT.pm +++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/file/FAT.pm @@ -5,7 +5,7 @@ use warnings; use parent 'URI::file::Win32'; -our $VERSION = '5.10'; +our $VERSION = '5.27'; sub fix_path { diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/file/Mac.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/file/Mac.pm index ee7bf57877..561982e93b 100644 --- a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/file/Mac.pm +++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/file/Mac.pm @@ -7,7 +7,7 @@ use parent 'URI::file::Base'; use URI::Escape qw(uri_unescape); -our $VERSION = '5.10'; +our $VERSION = '5.27'; sub _file_extract_path { diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/file/OS2.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/file/OS2.pm index 14ec91570b..357e9a43f0 100644 --- a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/file/OS2.pm +++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/file/OS2.pm @@ -5,7 +5,7 @@ use warnings; use parent 'URI::file::Win32'; -our $VERSION = '5.10'; +our $VERSION = '5.27'; # The Win32 version translates k:/foo to file://k:/foo (?!) # We add an empty host diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/file/QNX.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/file/QNX.pm index cb47809898..7c6463e2ff 100644 --- a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/file/QNX.pm +++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/file/QNX.pm @@ -5,7 +5,7 @@ use warnings; use parent 'URI::file::Unix'; -our $VERSION = '5.10'; +our $VERSION = '5.27'; sub _file_extract_path { diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/file/Unix.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/file/Unix.pm index fa226f7765..0c35e91d81 100644 --- a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/file/Unix.pm +++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/file/Unix.pm @@ -7,7 +7,7 @@ use parent 'URI::file::Base'; use URI::Escape qw(uri_unescape); -our $VERSION = '5.10'; +our $VERSION = '5.27'; sub _file_extract_path { diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/file/Win32.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/file/Win32.pm index bc1b373b4e..4a7f0f3bef 100644 --- a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/file/Win32.pm +++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/file/Win32.pm @@ -7,7 +7,7 @@ use parent 'URI::file::Base'; use URI::Escape qw(uri_unescape); -our $VERSION = '5.10'; +our $VERSION = '5.27'; sub _file_extract_authority { diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/ftp.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/ftp.pm index a6c12df271..d0ba16f754 100644 --- a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/ftp.pm +++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/ftp.pm @@ -3,7 +3,7 @@ package URI::ftp; use strict; use warnings; -our $VERSION = '5.10'; +our $VERSION = '5.27'; use parent qw(URI::_server URI::_userpass); diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/geo.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/geo.pm new file mode 100755 index 0000000000..da2b9517ad --- /dev/null +++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/geo.pm @@ -0,0 +1,418 @@ +package URI::geo; + +use warnings; +use strict; + +use Carp; +use URI::Split qw( uri_split uri_join ); + +use base qw( URI ); + +our $VERSION = '5.27'; + +sub _MINIMUM_LATITUDE { return -90 } +sub _MAXIMUM_LATITUDE { return 90 } +sub _MINIMUM_LONGITUDE { return -180 } +sub _MAXIMUM_LONGITUDE { return 180 } +sub _MAX_POINTY_PARAMETERS { return 3 } + +sub _can { + my ($can_pt, @keys) = @_; + for my $key (@keys) { + return $key if $can_pt->can($key); + } + return; +} + +sub _has { + my ($has_pt, @keys) = @_; + for my $key (@keys) { + return $key if exists $has_pt->{$key}; + } + return; +} + +# Try hard to extract location information from something. We handle lat, +# lon, alt as scalars, arrays containing lat, lon, alt, hashes with +# suitably named keys and objects with suitably named methods. + +sub _location_of_pointy_thing { + my ($class, @parameters) = @_; + + my @lat = qw( lat latitude ); + my @lon = qw( lon long longitude lng ); + my @ele = qw( ele alt elevation altitude ); + + if (ref $parameters[0]) { + my $pt = shift @parameters; + + if (@parameters) { + croak q[Too many arguments]; + } + + if (eval { $pt->can('can') }) { + for my $m (qw( location latlong )) { + return $pt->$m() if _can($pt, $m); + } + + my $latk = _can($pt, @lat); + my $lonk = _can($pt, @lon); + my $elek = _can($pt, @ele); + + if (defined $latk && defined $lonk) { + return $pt->$latk(), $pt->$lonk(), + defined $elek ? $pt->$elek() : undef; + } + } + elsif ('ARRAY' eq ref $pt) { + return $class->_location_of_pointy_thing(@{$pt}); + } + elsif ('HASH' eq ref $pt) { + + my $latk = _has($pt, @lat); + my $lonk = _has($pt, @lon); + my $elek = _has($pt, @ele); + + if (defined $latk && defined $lonk) { + return $pt->{$latk}, $pt->{$lonk}, + defined $elek ? $pt->{$elek} : undef; + } + } + + croak q[Don't know how to convert point]; + } + else { + croak q[Need lat, lon or lat, lon, alt] + if @parameters < 2 || @parameters > _MAX_POINTY_PARAMETERS(); + return my ($lat, $lon, $alt) = @parameters; + } +} + +sub _num { + my ($class, $n) = @_; + if (!defined $n) { + return q[]; + } + (my $rep = sprintf '%f', $n) =~ s/[.]0*$//smx; + return $rep; +} + +sub new { + my ($self, @parameters) = @_; + my $class = ref $self || $self; + my $uri = uri_join 'geo', undef, $class->_path(@parameters); + return bless \$uri, $class; +} + +sub _init { + my ($class, $uri, $scheme) = @_; + + my $self = $class->SUPER::_init($uri, $scheme); + + # Normalise at poles. + my $lat = $self->latitude; + if ($lat == _MAXIMUM_LATITUDE() || $lat == _MINIMUM_LATITUDE()) { + $self->longitude(0); + } + return $self; +} + +sub location { + my ($self, @parameters) = @_; + + if (@parameters) { + my ($lat, $lon, $alt) = @parameters; + return $self->latitude($lat)->longitude($lon)->altitude($alt); + } + + return $self->latitude, $self->longitude, $self->altitude; +} + +sub latitude { + my ($self, @parameters) = @_; + return $self->field('latitude', @parameters); +} + +sub longitude { + my ($self, @parameters) = @_; + return $self->field('longitude', @parameters); +} + +sub altitude { + my ($self, @parameters) = @_; + return $self->field('altitude', @parameters); +} + +sub crs { + my ($self, @parameters) = @_; + return $self->field('crs', @parameters); +} + +sub uncertainty { + my ($self, @parameters) = @_; + return $self->field('uncertainty', @parameters); +} + +sub field { + my ($self, $name, @remainder) = @_; + my ($scheme, $auth, $v, $query, $frag) = $self->_parse; + + if (!exists $v->{$name}) { + croak "No such field: $name"; + } + if (!@remainder) { + return $v->{$name}; + } + $v->{$name} = shift @remainder; + ${$self} = uri_join $scheme, $auth, $self->_format($v), $query, $frag; + return $self; +} + +{ + my $pnum = qr{\d+(?:[.]\d+)?}smx; + my $num = qr{-?$pnum}smx; + my $crsp = qr{(?:;crs=(\w+))}smx; + my $uncp = qr{(?:;u=($pnum))}smx; + my $parm = qr{(?:;\w+=[^;]*)+}smx; + + sub _parse { + my $self = shift; + my ($scheme, $auth, $path, $query, $frag) = uri_split ${$self}; + + $path =~ m{^ ($num), ($num) (?: , ($num) ) ? + (?: $crsp ) ? + (?: $uncp ) ? + ( $parm ) ? + $}smx or croak 'Badly formed geo uri'; + + # No named captures before 5.10.0 + return $scheme, $auth, + { + latitude => $1, + longitude => $2, + altitude => $3, + crs => $4, + uncertainty => $5, + parameters => (defined $6 ? substr $6, 1 : undef), + }, + $query, $frag; + } +} + +sub _format { + my ($class, $v) = @_; + return join q[;], + ( + join q[,], + map { $class->_num($_) } @{$v}{'latitude', 'longitude'}, + (defined $v->{altitude} ? ($v->{altitude}) : ()) + ), + (defined $v->{crs} ? ('crs=' . $class->_num($v->{crs})) : ()), + ( + defined $v->{uncertainty} + ? ('u=' . $class->_num($v->{uncertainty})) + : ()), (defined $v->{parameters} ? ($v->{parameters}) : ()); +} + +sub _path { + my ($class, @parameters) = @_; + my ($lat, $lon, $alt) = $class->_location_of_pointy_thing(@parameters); + croak 'Latitude out of range' + if $lat < _MINIMUM_LATITUDE() || $lat > _MAXIMUM_LATITUDE(); + croak 'Longitude out of range' + if $lon < _MINIMUM_LONGITUDE() || $lon > _MAXIMUM_LONGITUDE(); + if ($lat == _MINIMUM_LATITUDE() || $lat == _MAXIMUM_LATITUDE()) { + $lat = 0; + } + return $class->_format( + {latitude => $lat, longitude => $lon, altitude => $alt}); +} + +1; + +__END__ + +=head1 NAME + +URI::geo - URI scheme for geo Identifiers + +=head1 SYNOPSIS + + use URI; + + # Geo URI from textual uri + my $guri = URI->new( 'geo:54.786989,-2.344214' ); + + # From coordinates + my $guri = URI::geo->new( 54.786989, -2.344214 ); + + # Decode + my ( $lat, $lon, $alt ) = $guri->location; + my $latitude = $guri->latitude; + + # Update + $guri->location( 55, -1 ); + $guri->longitude( -43.23 ); + +=head1 DESCRIPTION + +From L<http://geouri.org/>: + + More and more protocols and data formats are being extended by methods + to add geographic information. However, all of those options are tied + to that specific protocol or data format. + + A dedicated Uniform Resource Identifier (URI) scheme for geographic + locations would be independent from any protocol, usable by any + software/data format that can handle generich URIs. Like a "mailto:" + URI launches your favourite mail application today, a "geo:" URI could + soon launch your favourite mapping service, or queue that location for + a navigation device. + +=head1 SUBROUTINES/METHODS + +=head2 C<< new >> + +Create a new URI::geo. The arguments should be either + +=over + +=item * latitude, longitude and optionally altitude + +=item * a reference to an array containing lat, lon, alt + +=item * a reference to a hash with suitably named keys or + +=item * a reference to an object with suitably named accessors + +=back + +To maximize the likelihood that you can pass in some object that +represents a geographical location and have URI::geo do the right thing +we try a number of different accessor names. + +If the object has a C<latlong> method (e.g. L<Geo::Point>) we'll use that. +If there's a C<location> method we call that. Otherwise we look for +accessors called C<lat>, C<latitude>, C<lon>, C<long>, C<longitude>, +C<ele>, C<alt>, C<elevation> or C<altitude> and use them. + +Often if you have an object or hash reference that represents a point +you can pass it directly to C<new>; so for example this will work: + + use URI::geo; + use Geo::Point; + + my $pt = Geo::Point->latlong( 48.208333, 16.372778 ); + my $guri = URI::geo->new( $pt ); + +As will this: + + my $guri = URI::geo->new( { lat => 55, lon => -1 } ); + +and this: + + my $guri = URI::geo->new( 55, -1 ); + +Note that you can also create a new C<URI::geo> by passing a Geo URI to +C<URI::new>: + + use URI; + + my $guri = URI->new( 'geo:55,-1' ); + +=head2 C<location> + +Get or set the location of this geo URI. + + my ( $lat, $lon, $alt ) = $guri->location; + $guri->location( 55.3, -3.7, 120 ); + +When setting the location it is possible to pass any of the argument +types that can be passed to C<new>. + +=head2 C<latitude> + +Get or set the latitude of this geo URI. + +=head2 C<longitude> + +Get or set the longitude of this geo URI. + +=head2 C<altitude> + +Get or set the L<altitude|https://en.wikipedia.org/wiki/Geo_URI_scheme#Altitude> of this geo URI. To delete the altitude set it to C<undef>. + +=head2 C<crs> + +Get or set the L<Coordinate Reference System|https://en.wikipedia.org/wiki/Geo_URI_scheme#Coordinate_reference_systems> of this geo URI. To delete the CRS set it to C<undef>. + +=head2 C<uncertainty> + +Get or set the L<uncertainty|https://en.wikipedia.org/wiki/Geo_URI_scheme#Uncertainty> of this geo URI. To delete the uncertainty set it to C<undef>. + +=head2 C<field> + +=head1 CONFIGURATION AND ENVIRONMENT + +URI::geo requires no configuration files or environment variables. + +=head1 DEPENDENCIES + +L<URI> + +=head1 DIAGNOSTICS + +=over + +=item C<< Too many arguments >> + +The L<new|/new> method can only accept three parameters; latitude, longitude and altitude. + +=item C<< Don't know how to convert point >> + +The L<new|/new> method doesn't know how to convert the supplied parameters into a URI::geo object. + +=item C<< Need lat, lon or lat, lon, alt >> + +The L<new|/new> method needs two (latitude and longitude) or three (latitude, longitude and altitude) parameters in a list. Any less or more than this is an error. + +=item C<< No such field: %s >> + +This field is not a known field for the L<URI::geo|URI::geo> object. + +=item C<< Badly formed geo uri >> + +The L<URI|URI> cannot be parsed as a URI + +=item C<< Badly formed geo uri >> + +The L<URI|URI> cannot be parsed as a URI + +=item C<< Latitude out of range >> + +Latitude may only be from -90 to +90 + +=item C<< Longitude out of range >> + +Longitude may only be from -180 to +180 + +=back + +=head1 INCOMPATIBILITIES + +None reported. + +=head1 BUGS AND LIMITATIONS + +To report a bug, or view the current list of bugs, please visit L<https://github.com/libwww-perl/URI/issues> + +=head1 AUTHOR + +Andy Armstrong C<< <andy@hexten.net> >> + +=head1 LICENSE AND COPYRIGHT + +Copyright (c) 2009, Andy Armstrong C<< <andy@hexten.net> >>. + +This module is free software; you can redistribute it and/or +modify it under the same terms as Perl itself. See L<perlartistic>. diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/gopher.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/gopher.pm index febd95c0ba..0ab8513eca 100644 --- a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/gopher.pm +++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/gopher.pm @@ -3,7 +3,7 @@ package URI::gopher; # <draft-murali-url-gopher>, Dec 4, 1996 use strict; use warnings; -our $VERSION = '5.10'; +our $VERSION = '5.27'; use parent 'URI::_server'; diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/http.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/http.pm index 50a09f0989..6f970bb034 100644 --- a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/http.pm +++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/http.pm @@ -3,7 +3,7 @@ package URI::http; use strict; use warnings; -our $VERSION = '5.10'; +our $VERSION = '5.27'; use parent 'URI::_server'; diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/https.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/https.pm index e3283e57c0..9b8c4c6b6c 100644 --- a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/https.pm +++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/https.pm @@ -3,7 +3,7 @@ package URI::https; use strict; use warnings; -our $VERSION = '5.10'; +our $VERSION = '5.27'; use parent 'URI::http'; diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/icap.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/icap.pm new file mode 100755 index 0000000000..674078dffe --- /dev/null +++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/icap.pm @@ -0,0 +1,76 @@ +package URI::icap; + +use strict; +use warnings; +use base qw(URI::http); + +our $VERSION = '5.27'; + +sub default_port { return 1344 } + +1; +__END__ + +=head1 NAME + +URI::icap - URI scheme for ICAP Identifiers + +=head1 VERSION + +Version 5.20 + +=head1 SYNOPSIS + + use URI::icap; + + my $uri = URI->new('icap://icap-proxy.example.com/'); + +=head1 DESCRIPTION + +This module implements the C<icap:> URI scheme defined in L<RFC 3507|http://tools.ietf.org/html/rfc3507>, for the L<Internet Content Adaptation Protocol|https://en.wikipedia.org/wiki/Internet_Content_Adaptation_Protocol>. + +=head1 SUBROUTINES/METHODS + +This module inherits the behaviour of L<URI::http|URI::http> and overrides the L<default_port|URI#$uri->default_port> method. + +=head2 default_port + +The default port for icap servers is 1344 + +=head1 DIAGNOSTICS + +See L<URI|URI> + +=head1 CONFIGURATION AND ENVIRONMENT + +See L<URI|URI#CONFIGURATION-VARIABLES> and L<URI|URI#ENVIRONMENT-VARIABLES> + +=head1 DEPENDENCIES + +None + +=head1 INCOMPATIBILITIES + +None reported + +=head1 BUGS AND LIMITATIONS + +See L<URI|URI#BUGS> + +=head1 SEE ALSO + +L<RFC 3507|http://tools.ietf.org/html/rfc3507> + +=head1 AUTHOR + +David Dick, C<< <ddick at cpan.org> >> + +=head1 LICENSE AND COPYRIGHT + +Copyright 2016 David Dick. + +This program is free software; you can redistribute it and/or modify it +under the terms of either: the GNU General Public License as published +by the Free Software Foundation; or the Artistic License. + +See L<http://dev.perl.org/licenses/> for more information. diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/icaps.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/icaps.pm new file mode 100755 index 0000000000..dd171439fe --- /dev/null +++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/icaps.pm @@ -0,0 +1,76 @@ +package URI::icaps; + +use strict; +use warnings; +use base qw(URI::icap); + +our $VERSION = '5.27'; + +sub secure { return 1 } + +1; +__END__ + +=head1 NAME + +URI::icaps - URI scheme for ICAPS Identifiers + +=head1 VERSION + +Version 5.20 + +=head1 SYNOPSIS + + use URI::icaps; + + my $uri = URI->new('icaps://icap-proxy.example.com/'); + +=head1 DESCRIPTION + +This module implements the C<icaps:> URI scheme defined in L<RFC 3507|http://tools.ietf.org/html/rfc3507>, for the L<Internet Content Adaptation Protocol|https://en.wikipedia.org/wiki/Internet_Content_Adaptation_Protocol>. + +=head1 SUBROUTINES/METHODS + +This module inherits the behaviour of L<URI::icap|URI::icap> and overrides the L<secure|URI#$uri->secure> method. + +=head2 secure + +returns 1 as icaps is a secure protocol + +=head1 DIAGNOSTICS + +See L<URI::icap|URI::icap> + +=head1 CONFIGURATION AND ENVIRONMENT + +See L<URI::icap|URI::icap> + +=head1 DEPENDENCIES + +None + +=head1 INCOMPATIBILITIES + +None reported + +=head1 BUGS AND LIMITATIONS + +See L<URI::icap|URI::icap> + +=head1 SEE ALSO + +L<RFC 3507|http://tools.ietf.org/html/rfc3507> + +=head1 AUTHOR + +David Dick, C<< <ddick at cpan.org> >> + +=head1 LICENSE AND COPYRIGHT + +Copyright 2016 David Dick. + +This program is free software; you can redistribute it and/or modify it +under the terms of either: the GNU General Public License as published +by the Free Software Foundation; or the Artistic License. + +See L<http://dev.perl.org/licenses/> for more information. diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/ldap.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/ldap.pm index 2977954b5a..566f22c9cd 100644 --- a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/ldap.pm +++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/ldap.pm @@ -7,7 +7,7 @@ package URI::ldap; use strict; use warnings; -our $VERSION = '5.10'; +our $VERSION = '5.27'; use parent qw(URI::_ldap URI::_server); diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/ldapi.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/ldapi.pm index e3bac5a860..d792d1f020 100644 --- a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/ldapi.pm +++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/ldapi.pm @@ -3,7 +3,7 @@ package URI::ldapi; use strict; use warnings; -our $VERSION = '5.10'; +our $VERSION = '5.27'; use parent qw(URI::_ldap URI::_generic); diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/ldaps.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/ldaps.pm index 4d58c67e38..d79f504aac 100644 --- a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/ldaps.pm +++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/ldaps.pm @@ -3,7 +3,7 @@ package URI::ldaps; use strict; use warnings; -our $VERSION = '5.10'; +our $VERSION = '5.27'; use parent 'URI::ldap'; diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/mailto.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/mailto.pm index 5d6f241080..34215752cc 100644 --- a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/mailto.pm +++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/mailto.pm @@ -3,7 +3,7 @@ package URI::mailto; # RFC 2368 use strict; use warnings; -our $VERSION = '5.10'; +our $VERSION = '5.27'; use parent qw(URI URI::_query); diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/mms.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/mms.pm index 6a41297484..dfa02a2dfe 100644 --- a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/mms.pm +++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/mms.pm @@ -3,7 +3,7 @@ package URI::mms; use strict; use warnings; -our $VERSION = '5.10'; +our $VERSION = '5.27'; use parent 'URI::http'; diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/news.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/news.pm index 4092981be0..19e3f2271d 100644 --- a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/news.pm +++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/news.pm @@ -3,7 +3,7 @@ package URI::news; # draft-gilman-news-url-01 use strict; use warnings; -our $VERSION = '5.10'; +our $VERSION = '5.27'; use parent 'URI::_server'; diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/nntp.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/nntp.pm index be276893d0..1386e9426b 100644 --- a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/nntp.pm +++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/nntp.pm @@ -3,7 +3,7 @@ package URI::nntp; # draft-gilman-news-url-01 use strict; use warnings; -our $VERSION = '5.10'; +our $VERSION = '5.27'; use parent 'URI::news'; diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/nntps.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/nntps.pm index a10e99293a..d37fed6b3c 100755 --- a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/nntps.pm +++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/nntps.pm @@ -3,7 +3,7 @@ package URI::nntps; use strict; use warnings; -our $VERSION = '5.10'; +our $VERSION = '5.27'; use parent 'URI::nntp'; diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/pop.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/pop.pm index accab911b4..0ac79d8409 100644 --- a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/pop.pm +++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/pop.pm @@ -3,7 +3,7 @@ package URI::pop; # RFC 2384 use strict; use warnings; -our $VERSION = '5.10'; +our $VERSION = '5.27'; use parent 'URI::_server'; diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/rlogin.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/rlogin.pm index 049ff4a026..a89ac837e1 100644 --- a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/rlogin.pm +++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/rlogin.pm @@ -3,7 +3,7 @@ package URI::rlogin; use strict; use warnings; -our $VERSION = '5.10'; +our $VERSION = '5.27'; use parent 'URI::_login'; diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/rsync.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/rsync.pm index 164c6b7d55..166a1d4c6a 100644 --- a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/rsync.pm +++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/rsync.pm @@ -5,7 +5,7 @@ package URI::rsync; # http://rsync.samba.org/ use strict; use warnings; -our $VERSION = '5.10'; +our $VERSION = '5.27'; use parent qw(URI::_server URI::_userpass); diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/rtsp.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/rtsp.pm index 48429f7e1a..939e625fb6 100644 --- a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/rtsp.pm +++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/rtsp.pm @@ -3,7 +3,7 @@ package URI::rtsp; use strict; use warnings; -our $VERSION = '5.10'; +our $VERSION = '5.27'; use parent 'URI::http'; diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/rtspu.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/rtspu.pm index c9bc64d49d..3af9fe4825 100644 --- a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/rtspu.pm +++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/rtspu.pm @@ -3,7 +3,7 @@ package URI::rtspu; use strict; use warnings; -our $VERSION = '5.10'; +our $VERSION = '5.27'; use parent 'URI::rtsp'; diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/sftp.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/sftp.pm index 4c9a1f38bf..1af2e368d7 100644 --- a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/sftp.pm +++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/sftp.pm @@ -5,6 +5,6 @@ use warnings; use parent 'URI::ssh'; -our $VERSION = '5.10'; +our $VERSION = '5.27'; 1; diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/sip.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/sip.pm index a6aeb858ac..f3ce0f5c09 100644 --- a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/sip.pm +++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/sip.pm @@ -14,7 +14,7 @@ use parent qw(URI::_server URI::_userpass); use URI::Escape (); -our $VERSION = '5.10'; +our $VERSION = '5.27'; sub default_port { 5060 } @@ -22,37 +22,33 @@ sub authority { my $self = shift; $$self =~ m,^($URI::scheme_re:)?([^;?]*)(.*)$,os or die; - my $old = $2; + my $start = $1; + my $authoritystr = $2; + my $rest = $3; if (@_) { - my $auth = shift; - $$self = defined($1) ? $1 : ""; - my $rest = $3; - if (defined $auth) { - $auth =~ s/([^$URI::uric])/ URI::Escape::escape_char($1)/ego; - $$self .= "$auth"; - } - $$self .= $rest; + $authoritystr = shift; + $authoritystr =~ s/([^$URI::uric])/ URI::Escape::escape_char($1)/ego; + $$self = $start . $authoritystr . $rest; } - $old; + return $authoritystr; } sub params_form { my $self = shift; $$self =~ m,^((?:$URI::scheme_re:)?)(?:([^;?]*))?(;[^?]*)?(.*)$,os or die; + my $start = $1 . $2; my $paramstr = $3; + my $rest = $4; if (@_) { - my @args = @_; - $$self = $1 . $2; - my $rest = $4; - my @new; - for (my $i=0; $i < @args; $i += 2) { - push(@new, "$args[$i]=$args[$i+1]"); + my @paramarr; + for (my $i = 0; $i < @_; $i += 2) { + push(@paramarr, "$_[$i]=$_[$i+1]"); } - $paramstr = join(";", @new); - $$self .= ";" . $paramstr . $rest; + $paramstr = join(";", @paramarr); + $$self = $start . ";" . $paramstr . $rest; } $paramstr =~ s/^;//o; return split(/[;=]/, $paramstr); @@ -62,13 +58,13 @@ sub params { my $self = shift; $$self =~ m,^((?:$URI::scheme_re:)?)(?:([^;?]*))?(;[^?]*)?(.*)$,os or die; + my $start = $1 . $2; my $paramstr = $3; + my $rest = $4; if (@_) { - my $new = shift; - $$self = $1 . $2; - my $rest = $4; - $$self .= $paramstr . $rest; + $paramstr = shift; + $$self = $start . ";" . $paramstr . $rest; } $paramstr =~ s/^;//o; return $paramstr; diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/sips.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/sips.pm index 3d7c2f2d6a..df6e75bd1e 100644 --- a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/sips.pm +++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/sips.pm @@ -3,7 +3,7 @@ package URI::sips; use strict; use warnings; -our $VERSION = '5.10'; +our $VERSION = '5.27'; use parent 'URI::sip'; diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/snews.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/snews.pm index e541482125..2c862f51d2 100644 --- a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/snews.pm +++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/snews.pm @@ -3,7 +3,7 @@ package URI::snews; # draft-gilman-news-url-01 use strict; use warnings; -our $VERSION = '5.10'; +our $VERSION = '5.27'; use parent 'URI::news'; diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/ssh.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/ssh.pm index 7273c2b1a5..58340f7189 100644 --- a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/ssh.pm +++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/ssh.pm @@ -3,7 +3,7 @@ package URI::ssh; use strict; use warnings; -our $VERSION = '5.10'; +our $VERSION = '5.27'; use parent 'URI::_login'; diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/telnet.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/telnet.pm index 5d81650607..92db5d2533 100644 --- a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/telnet.pm +++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/telnet.pm @@ -3,7 +3,7 @@ package URI::telnet; use strict; use warnings; -our $VERSION = '5.10'; +our $VERSION = '5.27'; use parent 'URI::_login'; diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/tn3270.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/tn3270.pm index 53a341402e..2e9d8bc669 100644 --- a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/tn3270.pm +++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/tn3270.pm @@ -3,7 +3,7 @@ package URI::tn3270; use strict; use warnings; -our $VERSION = '5.10'; +our $VERSION = '5.27'; use parent 'URI::_login'; diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/urn.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/urn.pm index 75f3a9b646..40d4a3e323 100644 --- a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/urn.pm +++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/urn.pm @@ -3,14 +3,13 @@ package URI::urn; # RFC 2141 use strict; use warnings; -our $VERSION = '5.10'; +our $VERSION = '5.27'; use parent 'URI'; use Carp qw(carp); my %implementor; -my %require_attempted; sub _init { my $class = shift; @@ -30,13 +29,11 @@ sub _init { $impclass = "URI::urn::$id"; no strict 'refs'; unless (@{"${impclass}::ISA"}) { - if (not exists $require_attempted{$impclass}) { # Try to load it my $_old_error = $@; eval "require $impclass"; die $@ if $@ && $@ !~ /Can\'t locate.*in \@INC/; $@ = $_old_error; - } $impclass = "URI::urn" unless @{"${impclass}::ISA"}; } } @@ -44,7 +41,6 @@ sub _init { carp("Illegal namespace identifier '$nid' for URN '$self'") if $^W; } $implementor{$nid} = $impclass; - return $impclass->_urn_init($self, $nid); } diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/urn/isbn.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/urn/isbn.pm index 4986d701f6..ee1abafad1 100644 --- a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/urn/isbn.pm +++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/urn/isbn.pm @@ -3,7 +3,7 @@ package URI::urn::isbn; # RFC 3187 use strict; use warnings; -our $VERSION = '5.10'; +our $VERSION = '5.27'; use parent 'URI::urn'; diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/urn/oid.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/urn/oid.pm index 5ba279f68c..30f42527ea 100644 --- a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/urn/oid.pm +++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/urn/oid.pm @@ -3,7 +3,7 @@ package URI::urn::oid; # RFC 2061 use strict; use warnings; -our $VERSION = '5.10'; +our $VERSION = '5.27'; use parent 'URI::urn'; |