From ca5e9f3ed082e71d43d14006d1d2f62622b86d2a Mon Sep 17 00:00:00 2001 From: "shogo82148-slim[bot]" <90079370+shogo82148-slim[bot]@users.noreply.github.com> Date: Wed, 6 Nov 2024 16:50:54 +0000 Subject: [PATCH] update carton --- author/carton/cpanfile.snapshot | 107 +++++++++++++------------ bin/carton | 136 ++++++++++++++++++-------------- 2 files changed, 134 insertions(+), 109 deletions(-) diff --git a/author/carton/cpanfile.snapshot b/author/carton/cpanfile.snapshot index 20b8d963f..a765d19d5 100644 --- a/author/carton/cpanfile.snapshot +++ b/author/carton/cpanfile.snapshot @@ -1311,57 +1311,62 @@ DISTRIBUTIONS perl 5.006 strict 0 warnings 0 - URI-5.29 - pathname: O/OA/OALDERS/URI-5.29.tar.gz - provides: - URI 5.29 - URI::Escape 5.29 - URI::Heuristic 5.29 - URI::IRI 5.29 - URI::QueryParam 5.29 - URI::Split 5.29 - URI::URL 5.29 - URI::WithBase 5.29 - URI::data 5.29 - URI::file 5.29 - URI::file::Base 5.29 - URI::file::FAT 5.29 - URI::file::Mac 5.29 - URI::file::OS2 5.29 - URI::file::QNX 5.29 - URI::file::Unix 5.29 - URI::file::Win32 5.29 - URI::ftp 5.29 - URI::geo 5.29 - URI::gopher 5.29 - URI::http 5.29 - URI::https 5.29 - URI::icap 5.29 - URI::icaps 5.29 - URI::ldap 5.29 - URI::ldapi 5.29 - URI::ldaps 5.29 - URI::mailto 5.29 - URI::mms 5.29 - URI::news 5.29 - URI::nntp 5.29 - URI::nntps 5.29 - URI::otpauth 5.29 - URI::pop 5.29 - URI::rlogin 5.29 - URI::rsync 5.29 - URI::rtsp 5.29 - URI::rtspu 5.29 - URI::sftp 5.29 - URI::sip 5.29 - URI::sips 5.29 - URI::snews 5.29 - URI::ssh 5.29 - URI::telnet 5.29 - URI::tn3270 5.29 - URI::urn 5.29 - URI::urn::isbn 5.29 - URI::urn::oid 5.29 + URI-5.31 + pathname: O/OA/OALDERS/URI-5.31.tar.gz + provides: + URI 5.31 + URI::Escape 5.31 + URI::Heuristic 5.31 + URI::IRI 5.31 + URI::QueryParam 5.31 + URI::Split 5.31 + URI::URL 5.31 + URI::WithBase 5.31 + URI::data 5.31 + URI::file 5.31 + URI::file::Base 5.31 + URI::file::FAT 5.31 + URI::file::Mac 5.31 + URI::file::OS2 5.31 + URI::file::QNX 5.31 + URI::file::Unix 5.31 + URI::file::Win32 5.31 + URI::ftp 5.31 + URI::ftpes 5.31 + URI::ftps 5.31 + URI::geo 5.31 + URI::gopher 5.31 + URI::http 5.31 + URI::https 5.31 + URI::icap 5.31 + URI::icaps 5.31 + URI::irc 5.31 + URI::ircs 5.31 + URI::ldap 5.31 + URI::ldapi 5.31 + URI::ldaps 5.31 + URI::mailto 5.31 + URI::mms 5.31 + URI::news 5.31 + URI::nntp 5.31 + URI::nntps 5.31 + URI::otpauth 5.31 + URI::pop 5.31 + URI::rlogin 5.31 + URI::rsync 5.31 + URI::rtsp 5.31 + URI::rtspu 5.31 + URI::scp 5.31 + URI::sftp 5.31 + URI::sip 5.31 + URI::sips 5.31 + URI::snews 5.31 + URI::ssh 5.31 + URI::telnet 5.31 + URI::tn3270 5.31 + URI::urn 5.31 + URI::urn::isbn 5.31 + URI::urn::oid 5.31 requirements: Carp 0 Cwd 0 diff --git a/bin/carton b/bin/carton index 6c13c2c55..be2576e3b 100755 --- a/bin/carton +++ b/bin/carton @@ -2122,7 +2122,7 @@ $fatpacked{"Try/Tiny.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'TRY_TI TRY_TINY $fatpacked{"URI.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'URI'; - package URI;use strict;use warnings;our$VERSION='5.29';use constant HAS_RESERVED_SQUARE_BRACKETS=>$ENV{URI_HAS_RESERVED_SQUARE_BRACKETS}? 1 : 0;our ($ABS_REMOTE_LEADING_DOTS,$ABS_ALLOW_RELATIVE_SCHEME,$DEFAULT_QUERY_FORM_DELIMITER);my%implements;our$reserved=HAS_RESERVED_SQUARE_BRACKETS ? q(;/?:@&=+$,[]) : q(;/?:@&=+$,);our$mark=q(-_.!~*'());our$unreserved="A-Za-z0-9\Q$mark\E";our$uric=quotemeta($reserved).$unreserved ."%";our$uric4host=$uric .(HAS_RESERVED_SQUARE_BRACKETS ? '' : quotemeta(q([])));our$uric4user=quotemeta(q{!$'()*,;:._~%-+=%&})."A-Za-z0-9" .(HAS_RESERVED_SQUARE_BRACKETS ? quotemeta(q([])): '');our$scheme_re='[a-zA-Z][a-zA-Z0-9.+\-]*';our$schemes_without_host_part_re='data|ldapi|urn|sqlite|sqlite3';our$fallback_schemes_re='mailto';use Carp ();use URI::Escape ();use overload ('""'=>sub {${$_[0]}},'=='=>sub {_obj_eq(@_)},'!='=>sub {!_obj_eq(@_)},fallback=>1,);sub _obj_eq {return overload::StrVal($_[0])eq overload::StrVal($_[1])}sub new {my($class,$uri,$scheme)=@_;$uri=defined ($uri)? "$uri" : "";$uri =~ s/^<(?:URL:)?(.*)>$/$1/;$uri =~ s/^"(.*)"$/$1/;$uri =~ s/^\s+//;$uri =~ s/\s+$//;my$impclass;if ($uri =~ m/^($scheme_re):/so){$scheme=$1}else {if (($impclass=ref($scheme))){$scheme=$scheme->scheme}elsif ($scheme && $scheme =~ m/^($scheme_re)(?::|$)/o){$scheme=$1}}$impclass ||= implementor($scheme)|| do {require URI::_foreign;$impclass='URI::_foreign'};return$impclass->_init($uri,$scheme)}sub new_abs {my($class,$uri,$base)=@_;$uri=$class->new($uri,$base);$uri->abs($base)}sub _init {my$class=shift;my($str,$scheme)=@_;$str=$class->_uric_escape($str);$str="$scheme:$str" unless$str =~ /^$scheme_re:/o || $class->_no_scheme_ok;my$self=bless \$str,$class;$self}sub _fix_uric_escape_for_host_part {return if HAS_RESERVED_SQUARE_BRACKETS;return if $_[0]!~ /%/;return if $_[0]=~ m{^(?:$URI::schemes_without_host_part_re):}os;if ($_[0]=~ m{^(?:$URI::fallback_schemes_re):}os){$_[0]=~ s/\%5B/[/gi;$_[0]=~ s/\%5D/]/gi;return}if ($_[0]=~ m{^((?:$URI::scheme_re:)?)//([^/?\#]+)(.*)$}os){my$orig=$2;my ($user,$host)=$orig =~ /^(.*@)?([^@]*)$/;$user ||= '';my$port=$host =~ s/(:\d+)$// ? $1 : '';$host =~ s/\%5B/[/gi;$host =~ s/\%5D/]/gi;$_[0]=~ s/\Q$orig\E/$user$host$port/}}sub _uric_escape {my($class,$str)=@_;$str =~ s*([^$uric\#])* URI::Escape::escape_char($1) *ego;_fix_uric_escape_for_host_part($str);utf8::downgrade($str);return$str}my%require_attempted;sub implementor {my($scheme,$impclass)=@_;if (!$scheme || $scheme !~ /\A$scheme_re\z/o){require URI::_generic;return "URI::_generic"}$scheme=lc($scheme);if ($impclass){my$old=$implements{$scheme};$impclass->_init_implementor($scheme);$implements{$scheme}=$impclass;return$old}my$ic=$implements{$scheme};return$ic if$ic;$ic="URI::$scheme";$ic =~ s/\+/_P/g;$ic =~ s/\./_O/g;$ic =~ s/\-/_/g;no strict 'refs';unless (@{"${ic}::ISA"}){if (not exists$require_attempted{$ic}){$require_attempted{$ic}=1;my$_old_error=$@;eval "require $ic";die $@ if $@ && $@ !~ /Can\'t locate.*in \@INC/;$@=$_old_error}return undef unless @{"${ic}::ISA"}}$ic->_init_implementor($scheme);$implements{$scheme}=$ic;$ic}sub _init_implementor {my($class,$scheme)=@_}sub clone {my$self=shift;my$other=$$self;bless \$other,ref$self}sub TO_JSON {${$_[0]}}sub _no_scheme_ok {0}sub _scheme {my$self=shift;unless (@_){return undef unless $$self =~ /^($scheme_re):/o;return $1}my$old;my$new=shift;if (defined($new)&& length($new)){Carp::croak("Bad scheme '$new'")unless$new =~ /^$scheme_re$/o;$old=$1 if $$self =~ s/^($scheme_re)://o;my$newself=URI->new("$new:$$self");$$self=$$newself;bless$self,ref($newself)}else {if ($self->_no_scheme_ok){$old=$1 if $$self =~ s/^($scheme_re)://o;Carp::carp("Oops, opaque part now look like scheme")if $^W && $$self =~ m/^$scheme_re:/o}else {$old=$1 if $$self =~ m/^($scheme_re):/o}}return$old}sub scheme {my$scheme=shift->_scheme(@_);return undef unless defined$scheme;lc($scheme)}sub has_recognized_scheme {my$self=shift;return ref($self)!~ /^URI::_(?:foreign|generic)\z/}sub opaque {my$self=shift;unless (@_){$$self =~ /^(?:$scheme_re:)?([^\#]*)/o or die;return $1}$$self =~ /^($scheme_re:)? # optional scheme + package URI;use strict;use warnings;our$VERSION='5.31';use constant HAS_RESERVED_SQUARE_BRACKETS=>$ENV{URI_HAS_RESERVED_SQUARE_BRACKETS}? 1 : 0;our ($ABS_REMOTE_LEADING_DOTS,$ABS_ALLOW_RELATIVE_SCHEME,$DEFAULT_QUERY_FORM_DELIMITER);my%implements;our$reserved=HAS_RESERVED_SQUARE_BRACKETS ? q(;/?:@&=+$,[]) : q(;/?:@&=+$,);our$mark=q(-_.!~*'());our$unreserved="A-Za-z0-9\Q$mark\E";our$uric=quotemeta($reserved).$unreserved ."%";our$uric4host=$uric .(HAS_RESERVED_SQUARE_BRACKETS ? '' : quotemeta(q([])));our$uric4user=quotemeta(q{!$'()*,;:._~%-+=%&})."A-Za-z0-9" .(HAS_RESERVED_SQUARE_BRACKETS ? quotemeta(q([])): '');our$scheme_re='[a-zA-Z][a-zA-Z0-9.+\-]*';our$schemes_without_host_part_re='data|ldapi|urn|sqlite|sqlite3';our$fallback_schemes_re='mailto';use Carp ();use URI::Escape ();use overload ('""'=>sub {${$_[0]}},'=='=>sub {_obj_eq(@_)},'!='=>sub {!_obj_eq(@_)},fallback=>1,);sub _obj_eq {return overload::StrVal($_[0])eq overload::StrVal($_[1])}sub new {my($class,$uri,$scheme)=@_;$uri=defined ($uri)? "$uri" : "";$uri =~ s/^<(?:URL:)?(.*)>$/$1/;$uri =~ s/^"(.*)"$/$1/;$uri =~ s/^\s+//;$uri =~ s/\s+$//;my$impclass;if ($uri =~ m/^($scheme_re):/so){$scheme=$1}else {if (($impclass=ref($scheme))){$scheme=$scheme->scheme}elsif ($scheme && $scheme =~ m/^($scheme_re)(?::|$)/o){$scheme=$1}}$impclass ||= implementor($scheme)|| do {require URI::_foreign;$impclass='URI::_foreign'};return$impclass->_init($uri,$scheme)}sub new_abs {my($class,$uri,$base)=@_;$uri=$class->new($uri,$base);$uri->abs($base)}sub _init {my$class=shift;my($str,$scheme)=@_;$str=$class->_uric_escape($str);$str="$scheme:$str" unless$str =~ /^$scheme_re:/o || $class->_no_scheme_ok;my$self=bless \$str,$class;$self}sub _fix_uric_escape_for_host_part {return if HAS_RESERVED_SQUARE_BRACKETS;return if $_[0]!~ /%/;return if $_[0]=~ m{^(?:$URI::schemes_without_host_part_re):}os;if ($_[0]=~ m{^(?:$URI::fallback_schemes_re):}os){$_[0]=~ s/\%5B/[/gi;$_[0]=~ s/\%5D/]/gi;return}if ($_[0]=~ m{^((?:$URI::scheme_re:)?)//([^/?\#]+)(.*)$}os){my$orig=$2;my ($user,$host)=$orig =~ /^(.*@)?([^@]*)$/;$user ||= '';my$port=$host =~ s/(:\d+)$// ? $1 : '';$host =~ s/\%5B/[/gi;$host =~ s/\%5D/]/gi;$_[0]=~ s/\Q$orig\E/$user$host$port/}}sub _uric_escape {my($class,$str)=@_;$str =~ s*([^$uric\#])* URI::Escape::escape_char($1) *ego;_fix_uric_escape_for_host_part($str);utf8::downgrade($str);return$str}my%require_attempted;sub implementor {my($scheme,$impclass)=@_;if (!$scheme || $scheme !~ /\A$scheme_re\z/o){require URI::_generic;return "URI::_generic"}$scheme=lc($scheme);if ($impclass){my$old=$implements{$scheme};$impclass->_init_implementor($scheme);$implements{$scheme}=$impclass;return$old}my$ic=$implements{$scheme};return$ic if$ic;$ic="URI::$scheme";$ic =~ s/\+/_P/g;$ic =~ s/\./_O/g;$ic =~ s/\-/_/g;no strict 'refs';unless (@{"${ic}::ISA"}){if (not exists$require_attempted{$ic}){$require_attempted{$ic}=1;my$_old_error=$@;eval "require $ic";die $@ if $@ && $@ !~ /Can\'t locate.*in \@INC/;$@=$_old_error}return undef unless @{"${ic}::ISA"}}$ic->_init_implementor($scheme);$implements{$scheme}=$ic;$ic}sub _init_implementor {my($class,$scheme)=@_}sub clone {my$self=shift;my$other=$$self;bless \$other,ref$self}sub TO_JSON {${$_[0]}}sub _no_scheme_ok {0}sub _scheme {my$self=shift;unless (@_){return undef unless $$self =~ /^($scheme_re):/o;return $1}my$old;my$new=shift;if (defined($new)&& length($new)){Carp::croak("Bad scheme '$new'")unless$new =~ /^$scheme_re$/o;$old=$1 if $$self =~ s/^($scheme_re)://o;my$newself=URI->new("$new:$$self");$$self=$$newself;bless$self,ref($newself)}else {if ($self->_no_scheme_ok){$old=$1 if $$self =~ s/^($scheme_re)://o;Carp::carp("Oops, opaque part now look like scheme")if $^W && $$self =~ m/^$scheme_re:/o}else {$old=$1 if $$self =~ m/^($scheme_re):/o}}return$old}sub scheme {my$scheme=shift->_scheme(@_);return undef unless defined$scheme;lc($scheme)}sub has_recognized_scheme {my$self=shift;return ref($self)!~ /^URI::_(?:foreign|generic)\z/}sub opaque {my$self=shift;unless (@_){$$self =~ /^(?:$scheme_re:)?([^\#]*)/o or die;return $1}$$self =~ /^($scheme_re:)? # optional scheme ([^\#]*) # opaque (\#.*)? # optional fragment $/sx or die;my$old_scheme=$1;my$old_opaque=$2;my$old_frag=$3;my$new_opaque=shift;$new_opaque="" unless defined$new_opaque;$new_opaque =~ s/([^$uric])/ URI::Escape::escape_char($1)/ego;utf8::downgrade($new_opaque);$$self=defined($old_scheme)? $old_scheme : "";$$self .= $new_opaque;$$self .= $old_frag if defined$old_frag;$old_opaque}sub path {goto&opaque}sub fragment {my$self=shift;unless (@_){return undef unless $$self =~ /\#(.*)/s;return $1}my$old;$old=$1 if $$self =~ s/\#(.*)//s;my$new_frag=shift;if (defined$new_frag){$new_frag =~ s/([^$uric])/ URI::Escape::escape_char($1) /ego;utf8::downgrade($new_frag);$$self .= "#$new_frag"}$old}sub as_string {my$self=shift;$$self}sub as_iri {my$self=shift;my$str=$$self;if ($str =~ s/%([89a-fA-F][0-9a-fA-F])/chr(hex($1))/eg){require Encode;my$enc=Encode::find_encoding("UTF-8");my$u="";while (length$str){$u .= $enc->decode($str,Encode::FB_QUIET());if (length$str){$u .= URI::Escape::escape_char(substr($str,0,1,""))}}$str=$u}return$str}sub canonical {my$self=shift;my$scheme=$self->_scheme || "";my$uc_scheme=$scheme =~ /[A-Z]/;my$esc=$$self =~ /%[a-fA-F0-9]{2}/;return$self unless$uc_scheme || $esc;my$other=$self->clone;if ($uc_scheme){$other->_scheme(lc$scheme)}if ($esc){$$other =~ s{%([0-9a-fA-F]{2})} @@ -2132,7 +2132,7 @@ $fatpacked{"URI.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'URI'; URI $fatpacked{"URI/Escape.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'URI_ESCAPE'; - package URI::Escape;use strict;use warnings;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.29';use Carp ();for (0..255){$escapes{chr($_)}=sprintf("%%%02X",$_)}my%subst;my%Unsafe=(RFC2732=>qr/[^A-Za-z0-9\-_.!~*'()]/,RFC3986=>qr/[^A-Za-z0-9\-\._~]/,);sub uri_escape {my($text,$patn)=@_;return undef unless defined$text;my$re;if (defined$patn){if (ref$patn eq 'Regexp'){$text =~ s{($patn)}{ + package URI::Escape;use strict;use warnings;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.31';use Carp ();for (0..255){$escapes{chr($_)}=sprintf("%%%02X",$_)}my%subst;my%Unsafe=(RFC2732=>qr/[^A-Za-z0-9\-_.!~*'()]/,RFC3986=>qr/[^A-Za-z0-9\-\._~]/,);sub uri_escape {my($text,$patn)=@_;return undef unless defined$text;my$re;if (defined$patn){if (ref$patn eq 'Regexp'){$text =~ s{($patn)}{ join('', map +($escapes{$_} || _fail_hi($_)), split //, "$1") }ge;return$text}$re=$subst{$patn};if (!defined$re){$re=$patn;$re =~ s{(\[:\w+:\])|(\\)?([\[\]]|\\\z)}{ defined $1 ? $1 : defined $2 ? "$2$3" : "\\$3" @@ -2140,71 +2140,71 @@ $fatpacked{"URI/Escape.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'URI_ URI_ESCAPE $fatpacked{"URI/Heuristic.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'URI_HEURISTIC'; - package URI::Heuristic;use strict;use warnings;use Exporter 5.57 'import';our@EXPORT_OK=qw(uf_uri uf_uristr uf_url uf_urlstr);our$VERSION='5.29';our ($MY_COUNTRY,$DEBUG);sub MY_COUNTRY() {for ($MY_COUNTRY){return $_ if defined;$_=$ENV{COUNTRY};return $_ if defined;my@srcs=($ENV{LC_ALL},$ENV{LANG});if (my$httplang=$ENV{HTTP_ACCEPT_LANGUAGE}){for$httplang (split(/\s*,\s*/,$httplang)){if ($httplang =~ /^\s*([a-zA-Z]+)[_-]([a-zA-Z]{2})\s*$/){unshift(@srcs,"${1}_${2}");last}}}for (@srcs){next unless defined;return lc($1)if /^[a-zA-Z]+_([a-zA-Z]{2})(?:[.@]|$)/}require Net::Domain;my$fqdn=Net::Domain::hostfqdn();$_=lc($1)if$fqdn =~ /\.([a-zA-Z]{2})$/;return $_ if defined;return ($_=0)}}our%LOCAL_GUESSING=('us'=>[qw(www.ACME.gov www.ACME.mil)],'gb'=>[qw(www.ACME.co.uk www.ACME.org.uk www.ACME.ac.uk)],'au'=>[qw(www.ACME.com.au www.ACME.org.au www.ACME.edu.au)],'il'=>[qw(www.ACME.co.il www.ACME.org.il www.ACME.net.il)],);$LOCAL_GUESSING{uk}=$LOCAL_GUESSING{gb};sub uf_uristr ($) {local($_)=@_;print STDERR "uf_uristr: resolving $_\n" if$DEBUG;return unless defined;s/^\s+//;s/\s+$//;if (/^(www|web|home)[a-z0-9-]*(?:\.|$)/i){$_="http://$_"}elsif (/^(ftp|gopher|news|wais|https|http)[a-z0-9-]*(?:\.|$)/i){$_=lc($1)."://$_"}elsif ($^O ne "MacOS" && (m,^/, || m,^\.\.?/, || m,^[a-zA-Z]:[/\\],)){$_="file:$_"}elsif ($^O eq "MacOS" && m/:/){unless (m/^(ftp|gopher|news|wais|http|https|mailto):/){require URI::file;my$a=URI::file->new($_)->as_string;$_=($a =~ m/^file:/)? $a : "file:$a"}}elsif (/^\w+([\.\-]\w+)*\@(\w+\.)+\w{2,3}$/){$_="mailto:$_"}elsif (!/^[a-zA-Z][a-zA-Z0-9.+\-]*:/){if (s/^([-\w]+(?:\.[-\w]+)*)([\/:\?\#]|$)/$2/){my$host=$1;my$scheme="http";if (/^:(\d+)\b/){if ($1 =~ /^[56789]?443$/){$scheme="https"}elsif ($1 eq "21"){$scheme="ftp"}}if ($host !~ /\./ && $host ne "localhost"){my@guess;if (exists$ENV{URL_GUESS_PATTERN}){@guess=map {s/\bACME\b/$host/;$_}split(' ',$ENV{URL_GUESS_PATTERN})}else {if (MY_COUNTRY()){my$special=$LOCAL_GUESSING{MY_COUNTRY()};if ($special){my@special=@$special;push(@guess,map {s/\bACME\b/$host/;$_}@special)}else {push(@guess,"www.$host." .MY_COUNTRY())}}push(@guess,map "www.$host.$_","com","org","net","edu","int")}my$guess;for$guess (@guess){print STDERR "uf_uristr: gethostbyname('$guess.')..." if$DEBUG;if (gethostbyname("$guess.")){print STDERR "yes\n" if$DEBUG;$host=$guess;last}print STDERR "no\n" if$DEBUG}}$_="$scheme://$host$_"}else {}}print STDERR "uf_uristr: ==> $_\n" if$DEBUG;$_}sub uf_uri ($) {require URI;URI->new(uf_uristr($_[0]))}*uf_urlstr=\*uf_uristr;sub uf_url ($) {require URI::URL;URI::URL->new(uf_uristr($_[0]))}1; + package URI::Heuristic;use strict;use warnings;use Exporter 5.57 'import';our@EXPORT_OK=qw(uf_uri uf_uristr uf_url uf_urlstr);our$VERSION='5.31';our ($MY_COUNTRY,$DEBUG);sub MY_COUNTRY() {for ($MY_COUNTRY){return $_ if defined;$_=$ENV{COUNTRY};return $_ if defined;my@srcs=($ENV{LC_ALL},$ENV{LANG});if (my$httplang=$ENV{HTTP_ACCEPT_LANGUAGE}){for$httplang (split(/\s*,\s*/,$httplang)){if ($httplang =~ /^\s*([a-zA-Z]+)[_-]([a-zA-Z]{2})\s*$/){unshift(@srcs,"${1}_${2}");last}}}for (@srcs){next unless defined;return lc($1)if /^[a-zA-Z]+_([a-zA-Z]{2})(?:[.@]|$)/}require Net::Domain;my$fqdn=Net::Domain::hostfqdn();$_=lc($1)if$fqdn =~ /\.([a-zA-Z]{2})$/;return $_ if defined;return ($_=0)}}our%LOCAL_GUESSING=('us'=>[qw(www.ACME.gov www.ACME.mil)],'gb'=>[qw(www.ACME.co.uk www.ACME.org.uk www.ACME.ac.uk)],'au'=>[qw(www.ACME.com.au www.ACME.org.au www.ACME.edu.au)],'il'=>[qw(www.ACME.co.il www.ACME.org.il www.ACME.net.il)],);$LOCAL_GUESSING{uk}=$LOCAL_GUESSING{gb};sub uf_uristr ($) {local($_)=@_;print STDERR "uf_uristr: resolving $_\n" if$DEBUG;return unless defined;s/^\s+//;s/\s+$//;if (/^(www|web|home)[a-z0-9-]*(?:\.|$)/i){$_="http://$_"}elsif (/^(ftp|gopher|news|wais|https|http)[a-z0-9-]*(?:\.|$)/i){$_=lc($1)."://$_"}elsif ($^O ne "MacOS" && (m,^/, || m,^\.\.?/, || m,^[a-zA-Z]:[/\\],)){$_="file:$_"}elsif ($^O eq "MacOS" && m/:/){unless (m/^(ftp|gopher|news|wais|http|https|mailto):/){require URI::file;my$a=URI::file->new($_)->as_string;$_=($a =~ m/^file:/)? $a : "file:$a"}}elsif (/^\w+([\.\-]\w+)*\@(\w+\.)+\w{2,3}$/){$_="mailto:$_"}elsif (!/^[a-zA-Z][a-zA-Z0-9.+\-]*:/){if (s/^([-\w]+(?:\.[-\w]+)*)([\/:\?\#]|$)/$2/){my$host=$1;my$scheme="http";if (/^:(\d+)\b/){if ($1 =~ /^[56789]?443$/){$scheme="https"}elsif ($1 eq "21"){$scheme="ftp"}}if ($host !~ /\./ && $host ne "localhost"){my@guess;if (exists$ENV{URL_GUESS_PATTERN}){@guess=map {s/\bACME\b/$host/;$_}split(' ',$ENV{URL_GUESS_PATTERN})}else {if (MY_COUNTRY()){my$special=$LOCAL_GUESSING{MY_COUNTRY()};if ($special){my@special=@$special;push(@guess,map {s/\bACME\b/$host/;$_}@special)}else {push(@guess,"www.$host." .MY_COUNTRY())}}push(@guess,map "www.$host.$_","com","org","net","edu","int")}my$guess;for$guess (@guess){print STDERR "uf_uristr: gethostbyname('$guess.')..." if$DEBUG;if (gethostbyname("$guess.")){print STDERR "yes\n" if$DEBUG;$host=$guess;last}print STDERR "no\n" if$DEBUG}}$_="$scheme://$host$_"}else {}}print STDERR "uf_uristr: ==> $_\n" if$DEBUG;$_}sub uf_uri ($) {require URI;URI->new(uf_uristr($_[0]))}*uf_urlstr=\*uf_uristr;sub uf_url ($) {require URI::URL;URI::URL->new(uf_uristr($_[0]))}1; URI_HEURISTIC $fatpacked{"URI/IRI.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'URI_IRI'; - package URI::IRI;use strict;use warnings;use URI ();use overload '""'=>sub {shift->as_string};our$VERSION='5.29';sub new {my($class,$uri,$scheme)=@_;utf8::upgrade($uri);return bless {uri=>URI->new($uri,$scheme),},$class}sub clone {my$self=shift;return bless {uri=>$self->{uri}->clone,},ref($self)}sub as_string {my$self=shift;return$self->{uri}->as_iri}our$AUTOLOAD;sub AUTOLOAD {my$method=substr($AUTOLOAD,rindex($AUTOLOAD,'::')+2);no strict 'refs';*$method=sub {shift->{uri}->$method(@_)};goto &$method}sub DESTROY {}1; + package URI::IRI;use strict;use warnings;use URI ();use overload '""'=>sub {shift->as_string};our$VERSION='5.31';sub new {my($class,$uri,$scheme)=@_;utf8::upgrade($uri);return bless {uri=>URI->new($uri,$scheme),},$class}sub clone {my$self=shift;return bless {uri=>$self->{uri}->clone,},ref($self)}sub as_string {my$self=shift;return$self->{uri}->as_iri}our$AUTOLOAD;sub AUTOLOAD {my$method=substr($AUTOLOAD,rindex($AUTOLOAD,'::')+2);no strict 'refs';*$method=sub {shift->{uri}->$method(@_)};goto &$method}sub DESTROY {}1; URI_IRI $fatpacked{"URI/QueryParam.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'URI_QUERYPARAM'; - package URI::QueryParam;use strict;use warnings;our$VERSION='5.29';1; + package URI::QueryParam;use strict;use warnings;our$VERSION='5.31';1; URI_QUERYPARAM $fatpacked{"URI/Split.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'URI_SPLIT'; - package URI::Split;use strict;use warnings;our$VERSION='5.29';use Exporter 5.57 'import';our@EXPORT_OK=qw(uri_split uri_join);use URI::Escape ();sub uri_split {return $_[0]=~ m,(?:([^:/?#]+):)?(?://([^/?#]*))?([^?#]*)(?:\?([^#]*))?(?:#(.*))?,}sub uri_join {my($scheme,$auth,$path,$query,$frag)=@_;my$uri=defined($scheme)? "$scheme:" : "";$path="" unless defined$path;if (defined$auth){$auth =~ s,([/?\#]), URI::Escape::escape_char($1),eg;$uri .= "//$auth";$path="/$path" if length($path)&& $path !~ m,^/,}elsif ($path =~ m,^//,){$uri .= "//"}unless (length$uri){$path =~ s,(:), URI::Escape::escape_char($1),e while$path =~ m,^[^:/?\#]+:,}$path =~ s,([?\#]), URI::Escape::escape_char($1),eg;$uri .= $path;if (defined$query){$query =~ s,(\#), URI::Escape::escape_char($1),eg;$uri .= "?$query"}$uri .= "#$frag" if defined$frag;$uri}1; + package URI::Split;use strict;use warnings;our$VERSION='5.31';use Exporter 5.57 'import';our@EXPORT_OK=qw(uri_split uri_join);use URI::Escape ();sub uri_split {return $_[0]=~ m,(?:([^:/?#]+):)?(?://([^/?#]*))?([^?#]*)(?:\?([^#]*))?(?:#(.*))?,}sub uri_join {my($scheme,$auth,$path,$query,$frag)=@_;my$uri=defined($scheme)? "$scheme:" : "";$path="" unless defined$path;if (defined$auth){$auth =~ s,([/?\#]), URI::Escape::escape_char($1),eg;$uri .= "//$auth";$path="/$path" if length($path)&& $path !~ m,^/,}elsif ($path =~ m,^//,){$uri .= "//"}unless (length$uri){$path =~ s,(:), URI::Escape::escape_char($1),e while$path =~ m,^[^:/?\#]+:,}$path =~ s,([?\#]), URI::Escape::escape_char($1),eg;$uri .= $path;if (defined$query){$query =~ s,(\#), URI::Escape::escape_char($1),eg;$uri .= "?$query"}$uri .= "#$frag" if defined$frag;$uri}1; URI_SPLIT $fatpacked{"URI/URL.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'URI_URL'; - package URI::URL;use strict;use warnings;use parent 'URI::WithBase';our$VERSION='5.29';use Exporter 5.57 'import';our@EXPORT=qw(url);sub url ($;$) {URI::URL->new(@_)}use URI::Escape qw(uri_unescape);sub new {my$class=shift;my$self=$class->SUPER::new(@_);$self->[0]=$self->[0]->canonical;$self}sub newlocal {my$class=shift;require URI::file;bless [URI::file->new_abs(shift)],$class}{package URI::_foreign;sub _init {my$class=shift;die "Unknown URI::URL scheme $_[1]:" if$URI::URL::STRICT;$class->SUPER::_init(@_)}}sub strict {my$old=$URI::URL::STRICT;$URI::URL::STRICT=shift if @_;$old}sub print_on {my$self=shift;require Data::Dumper;print STDERR Data::Dumper::Dumper($self)}sub _try {my$self=shift;my$method=shift;scalar(eval {$self->$method(@_)})}sub crack {my$self=shift;(scalar($self->scheme),$self->_try("user"),$self->_try("password"),$self->_try("host"),$self->_try("port"),$self->_try("path"),$self->_try("params"),$self->_try("query"),scalar($self->fragment),)}sub full_path {my$self=shift;my$path=$self->path_query;$path="/" unless length$path;$path}sub netloc {shift->authority(@_)}sub epath {my$path=shift->SUPER::path(@_);$path =~ s/;.*//;$path}sub eparams {my$self=shift;my@p=$self->path_segments;return undef unless ref($p[-1]);@p=@{$p[-1]};shift@p;join(";",@p)}sub params {shift->eparams(@_)}sub path {my$self=shift;my$old=$self->epath(@_);return unless defined wantarray;return '/' if!defined($old)||!length($old);Carp::croak("Path components contain '/' (you must call epath)")if$old =~ /%2[fF]/ and!@_;$old="/$old" if$old !~ m|^/| && defined$self->netloc;return uri_unescape($old)}sub path_components {shift->path_segments(@_)}sub query {my$self=shift;my$old=$self->equery(@_);if (defined(wantarray)&& defined($old)){if ($old =~ /%(?:26|2[bB]|3[dD])/){my$mess;for ($old){$mess="Query contains both '+' and '%2B'" if /\+/ && /%2[bB]/;$mess="Form query contains escaped '=' or '&'" if /=/ && /%(?:3[dD]|26)/}if ($mess){Carp::croak("$mess (you must call equery)")}}return uri_unescape($old)}undef}sub abs {my$self=shift;my$base=shift;my$allow_scheme=shift;$allow_scheme=$URI::URL::ABS_ALLOW_RELATIVE_SCHEME unless defined$allow_scheme;local$URI::ABS_ALLOW_RELATIVE_SCHEME=$allow_scheme;local$URI::ABS_REMOTE_LEADING_DOTS=$URI::URL::ABS_REMOTE_LEADING_DOTS;$self->SUPER::abs($base)}sub frag {shift->fragment(@_)}sub keywords {shift->query_keywords(@_)}sub local_path {shift->file}sub unix_path {shift->file("unix")}sub dos_path {shift->file("dos")}sub mac_path {shift->file("mac")}sub vms_path {shift->file("vms")}sub address {shift->to(@_)}sub encoded822addr {shift->to(@_)}sub URI::mailto::authority {shift->to(@_)}sub groupart {shift->_group(@_)}sub article {shift->message(@_)}1; + package URI::URL;use strict;use warnings;use parent 'URI::WithBase';our$VERSION='5.31';use Exporter 5.57 'import';our@EXPORT=qw(url);sub url ($;$) {URI::URL->new(@_)}use URI::Escape qw(uri_unescape);sub new {my$class=shift;my$self=$class->SUPER::new(@_);$self->[0]=$self->[0]->canonical;$self}sub newlocal {my$class=shift;require URI::file;bless [URI::file->new_abs(shift)],$class}{package URI::_foreign;sub _init {my$class=shift;die "Unknown URI::URL scheme $_[1]:" if$URI::URL::STRICT;$class->SUPER::_init(@_)}}sub strict {my$old=$URI::URL::STRICT;$URI::URL::STRICT=shift if @_;$old}sub print_on {my$self=shift;require Data::Dumper;print STDERR Data::Dumper::Dumper($self)}sub _try {my$self=shift;my$method=shift;scalar(eval {$self->$method(@_)})}sub crack {my$self=shift;(scalar($self->scheme),$self->_try("user"),$self->_try("password"),$self->_try("host"),$self->_try("port"),$self->_try("path"),$self->_try("params"),$self->_try("query"),scalar($self->fragment),)}sub full_path {my$self=shift;my$path=$self->path_query;$path="/" unless length$path;$path}sub netloc {shift->authority(@_)}sub epath {my$path=shift->SUPER::path(@_);$path =~ s/;.*//;$path}sub eparams {my$self=shift;my@p=$self->path_segments;return undef unless ref($p[-1]);@p=@{$p[-1]};shift@p;join(";",@p)}sub params {shift->eparams(@_)}sub path {my$self=shift;my$old=$self->epath(@_);return unless defined wantarray;return '/' if!defined($old)||!length($old);Carp::croak("Path components contain '/' (you must call epath)")if$old =~ /%2[fF]/ and!@_;$old="/$old" if$old !~ m|^/| && defined$self->netloc;return uri_unescape($old)}sub path_components {shift->path_segments(@_)}sub query {my$self=shift;my$old=$self->equery(@_);if (defined(wantarray)&& defined($old)){if ($old =~ /%(?:26|2[bB]|3[dD])/){my$mess;for ($old){$mess="Query contains both '+' and '%2B'" if /\+/ && /%2[bB]/;$mess="Form query contains escaped '=' or '&'" if /=/ && /%(?:3[dD]|26)/}if ($mess){Carp::croak("$mess (you must call equery)")}}return uri_unescape($old)}undef}sub abs {my$self=shift;my$base=shift;my$allow_scheme=shift;$allow_scheme=$URI::URL::ABS_ALLOW_RELATIVE_SCHEME unless defined$allow_scheme;local$URI::ABS_ALLOW_RELATIVE_SCHEME=$allow_scheme;local$URI::ABS_REMOTE_LEADING_DOTS=$URI::URL::ABS_REMOTE_LEADING_DOTS;$self->SUPER::abs($base)}sub frag {shift->fragment(@_)}sub keywords {shift->query_keywords(@_)}sub local_path {shift->file}sub unix_path {shift->file("unix")}sub dos_path {shift->file("dos")}sub mac_path {shift->file("mac")}sub vms_path {shift->file("vms")}sub address {shift->to(@_)}sub encoded822addr {shift->to(@_)}sub URI::mailto::authority {shift->to(@_)}sub groupart {shift->_group(@_)}sub article {shift->message(@_)}1; URI_URL $fatpacked{"URI/WithBase.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'URI_WITHBASE'; - package URI::WithBase;use strict;use warnings;use URI ();use Scalar::Util qw(blessed);our$VERSION='5.29';use overload '""'=>"as_string",fallback=>1;sub as_string;sub new {my($class,$uri,$base)=@_;my$ibase=$base;if ($base && blessed($base)&& $base->isa(__PACKAGE__)){$base=$base->abs;$ibase=$base->[0]}bless [URI->new($uri,$ibase),$base],$class}sub new_abs {my$class=shift;my$self=$class->new(@_);$self->abs}sub _init {my$class=shift;my($str,$scheme)=@_;bless [URI->new($str,$scheme),undef],$class}sub eq {my($self,$other)=@_;$other=$other->[0]if blessed($other)and $other->isa(__PACKAGE__);$self->[0]->eq($other)}our$AUTOLOAD;sub AUTOLOAD {my$self=shift;my$method=substr($AUTOLOAD,rindex($AUTOLOAD,'::')+2);return if$method eq "DESTROY";$self->[0]->$method(@_)}sub can {my$self=shift;$self->SUPER::can(@_)|| (ref($self)? $self->[0]->can(@_): undef)}sub base {my$self=shift;my$base=$self->[1];if (@_){my$new_base=shift;$new_base=$new_base->abs if ref($new_base)&& $new_base->isa(__PACKAGE__);$self->[1]=$new_base}return unless defined wantarray;if (defined($base)&&!ref($base)){$base=ref($self)->new($base);$self->[1]=$base unless @_}$base}sub clone {my$self=shift;my$base=$self->[1];$base=$base->clone if ref($base);bless [$self->[0]->clone,$base],ref($self)}sub abs {my$self=shift;my$base=shift || $self->base || return$self->clone;$base=$base->as_string if ref($base);bless [$self->[0]->abs($base,@_),$base],ref($self)}sub rel {my$self=shift;my$base=shift || $self->base || return$self->clone;$base=$base->as_string if ref($base);bless [$self->[0]->rel($base,@_),$base],ref($self)}1; + package URI::WithBase;use strict;use warnings;use URI ();use Scalar::Util qw(blessed);our$VERSION='5.31';use overload '""'=>"as_string",fallback=>1;sub as_string;sub new {my($class,$uri,$base)=@_;my$ibase=$base;if ($base && blessed($base)&& $base->isa(__PACKAGE__)){$base=$base->abs;$ibase=$base->[0]}bless [URI->new($uri,$ibase),$base],$class}sub new_abs {my$class=shift;my$self=$class->new(@_);$self->abs}sub _init {my$class=shift;my($str,$scheme)=@_;bless [URI->new($str,$scheme),undef],$class}sub eq {my($self,$other)=@_;$other=$other->[0]if blessed($other)and $other->isa(__PACKAGE__);$self->[0]->eq($other)}our$AUTOLOAD;sub AUTOLOAD {my$self=shift;my$method=substr($AUTOLOAD,rindex($AUTOLOAD,'::')+2);return if$method eq "DESTROY";$self->[0]->$method(@_)}sub can {my$self=shift;$self->SUPER::can(@_)|| (ref($self)? $self->[0]->can(@_): undef)}sub base {my$self=shift;my$base=$self->[1];if (@_){my$new_base=shift;$new_base=$new_base->abs if ref($new_base)&& $new_base->isa(__PACKAGE__);$self->[1]=$new_base}return unless defined wantarray;if (defined($base)&&!ref($base)){$base=ref($self)->new($base);$self->[1]=$base unless @_}$base}sub clone {my$self=shift;my$base=$self->[1];$base=$base->clone if ref($base);bless [$self->[0]->clone,$base],ref($self)}sub abs {my$self=shift;my$base=shift || $self->base || return$self->clone;$base=$base->as_string if ref($base);bless [$self->[0]->abs($base,@_),$base],ref($self)}sub rel {my$self=shift;my$base=shift || $self->base || return$self->clone;$base=$base->as_string if ref($base);bless [$self->[0]->rel($base,@_),$base],ref($self)}1; URI_WITHBASE $fatpacked{"URI/_foreign.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'URI__FOREIGN'; - package URI::_foreign;use strict;use warnings;use parent 'URI::_generic';our$VERSION='5.29';1; + package URI::_foreign;use strict;use warnings;use parent 'URI::_generic';our$VERSION='5.31';1; URI__FOREIGN $fatpacked{"URI/_generic.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'URI__GENERIC'; - package URI::_generic;use strict;use warnings;use parent qw(URI URI::_query);use URI::Escape qw(uri_unescape);use Carp ();our$VERSION='5.29';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){eval {require Regexp::IPv6;Regexp::IPv6->import(qw($IPv6_re));1}|| do {$IPv6_re=qr/[:0-9a-f]{3,}/}}return 0 unless$addr;return 0 if$addr =~ tr/:/:/ < 2;return 1 if$addr =~ /^$IPv6_re$/i;return 0}sub authority {my$self=shift;$$self =~ m,^((?:$URI::scheme_re:)?)(?://([^/?\#]*))?(.*)$,os or die;if (@_){my$auth=shift;$$self=$1;my$rest=$3;if (defined$auth){$auth =~ s/([^$ACHAR])/ URI::Escape::escape_char($1)/ego;if (my ($user,$host)=$auth =~ /^(.*@)?([^@]+)$/){$user ||= '';$user =~ s/([^$URI::uric4user])/ URI::Escape::escape_char($1)/ego;$user =~ s/%40$/\@/;$host="[$host]" if _looks_like_raw_ip6_address($host);$auth=$user .$host}utf8::downgrade($auth);$$self .= "//$auth"}_check_path($rest,$$self);$$self .= $rest}$2}sub path {my$self=shift;$$self =~ m,^((?:[^:/?\#]+:)?(?://[^/?\#]*)?)([^?\#]*)(.*)$,s or die;if (@_){$$self=$1;my$rest=$3;my$new_path=shift;$new_path="" unless defined$new_path;$new_path =~ s/([^$PCHAR])/ URI::Escape::escape_char($1)/ego;utf8::downgrade($new_path);_check_path($new_path,$$self);$$self .= $new_path .$rest}$2}sub path_query {my$self=shift;$$self =~ m,^((?:[^:/?\#]+:)?(?://[^/?\#]*)?)([^\#]*)(.*)$,s or die;if (@_){$$self=$1;my$rest=$3;my$new_path=shift;$new_path="" unless defined$new_path;$new_path =~ s/([^$URI::uric])/ URI::Escape::escape_char($1)/ego;utf8::downgrade($new_path);_check_path($new_path,$$self);$$self .= $new_path .$rest}$2}sub _check_path {my($path,$pre)=@_;my$prefix;if ($pre =~ m,/,){$prefix="/" if length($path)&& $path !~ m,^[/?\#],}else {if ($path =~ m,^//,){Carp::carp("Path starting with double slash is confusing")if $^W}elsif (!length($pre)&& $path =~ m,^[^:/?\#]+:,){Carp::carp("Path might look like scheme, './' prepended")if $^W;$prefix="./"}}substr($_[0],0,0)=$prefix if defined$prefix}sub path_segments {my$self=shift;my$path=$self->path;if (@_){my@arg=@_;for (@arg){if (ref($_)){my@seg=@$_;$seg[0]=~ s/%/%25/g;for (@seg){s/;/%3B/g}$_=join(";",@seg)}else {s/%/%25/g;s/;/%3B/g}s,/,%2F,g}$self->path(join("/",@arg))}return$path unless wantarray;map {/;/ ? $self->_split_segment($_): uri_unescape($_)}split('/',$path,-1)}sub _split_segment {my$self=shift;require URI::_segment;URI::_segment->new(@_)}sub abs {my$self=shift;my$base=shift || Carp::croak("Missing base argument");if (my$scheme=$self->scheme){return$self unless$URI::ABS_ALLOW_RELATIVE_SCHEME;$base=URI->new($base)unless ref$base;return$self unless$scheme eq $base->scheme}$base=URI->new($base)unless ref$base;my$abs=$self->clone;$abs->scheme($base->scheme);return$abs if $$self =~ m,^(?:$URI::scheme_re:)?//,o;$abs->authority($base->authority);my$path=$self->path;return$abs if$path =~ m,^/,;if (!length($path)){my$abs=$base->clone;my$query=$self->query;$abs->query($query)if defined$query;my$fragment=$self->fragment;$abs->fragment($fragment)if defined$fragment;return$abs}my$p=$base->path;$p =~ s,[^/]+$,,;$p .= $path;my@p=split('/',$p,-1);shift(@p)if@p &&!length($p[0]);my$i=1;while ($i < @p){if ($p[$i-1]eq "."){splice(@p,$i-1,1);$i-- if$i > 1}elsif ($p[$i]eq ".." && $p[$i-1]ne ".."){splice(@p,$i-1,2);if ($i > 1){$i--;push(@p,"")if$i==@p}}else {$i++}}$p[-1]="" if@p && $p[-1]eq ".";if ($URI::ABS_REMOTE_LEADING_DOTS){shift@p while@p && $p[0]=~ /^\.\.?$/}$abs->path("/" .join("/",@p));$abs}sub rel {my$self=shift;my$base=shift || Carp::croak("Missing base argument");my$rel=$self->clone;$base=URI->new($base)unless ref$base;my$scheme=$rel->scheme;my$auth=$rel->canonical->authority;my$path=$rel->path;if (!defined($scheme)&&!defined($auth)){return$rel}my$bscheme=$base->scheme;my$bauth=$base->canonical->authority;my$bpath=$base->path;for ($bscheme,$bauth,$auth){$_='' unless defined}unless ($scheme eq $bscheme && $auth eq $bauth){return$rel}for ($path,$bpath){$_="/$_" unless m,^/,}$rel->scheme(undef);$rel->authority(undef);my$li=1;while (1){my$i=index($path,'/',$li);last if$i < 0 || $i!=index($bpath,'/',$li)|| substr($path,$li,$i-$li)ne substr($bpath,$li,$i-$li);$li=$i+1}substr($path,0,$li)='';substr($bpath,0,$li)='';if ($path eq $bpath && defined($rel->fragment)&&!defined($rel->query)){$rel->path("")}else {$path=('../' x $bpath =~ tr|/|/|).$path;$path="./" if$path eq "";$rel->path($path)}$rel}1; + package URI::_generic;use strict;use warnings;use parent qw(URI URI::_query);use URI::Escape qw(uri_unescape);use Carp ();our$VERSION='5.31';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){eval {require Regexp::IPv6;Regexp::IPv6->import(qw($IPv6_re));1}|| do {$IPv6_re=qr/[:0-9a-f]{3,}/}}return 0 unless$addr;return 0 if$addr =~ tr/:/:/ < 2;return 1 if$addr =~ /^$IPv6_re$/i;return 0}sub authority {my$self=shift;$$self =~ m,^((?:$URI::scheme_re:)?)(?://([^/?\#]*))?(.*)$,os or die;if (@_){my$auth=shift;$$self=$1;my$rest=$3;if (defined$auth){$auth =~ s/([^$ACHAR])/ URI::Escape::escape_char($1)/ego;if (my ($user,$host)=$auth =~ /^(.*@)?([^@]+)$/){$user ||= '';$user =~ s/([^$URI::uric4user])/ URI::Escape::escape_char($1)/ego;$user =~ s/%40$/\@/;$host="[$host]" if _looks_like_raw_ip6_address($host);$auth=$user .$host}utf8::downgrade($auth);$$self .= "//$auth"}_check_path($rest,$$self);$$self .= $rest}$2}sub path {my$self=shift;$$self =~ m,^((?:[^:/?\#]+:)?(?://[^/?\#]*)?)([^?\#]*)(.*)$,s or die;if (@_){$$self=$1;my$rest=$3;my$new_path=shift;$new_path="" unless defined$new_path;$new_path =~ s/([^$PCHAR])/ URI::Escape::escape_char($1)/ego;utf8::downgrade($new_path);_check_path($new_path,$$self);$$self .= $new_path .$rest}$2}sub path_query {my$self=shift;$$self =~ m,^((?:[^:/?\#]+:)?(?://[^/?\#]*)?)([^\#]*)(.*)$,s or die;if (@_){$$self=$1;my$rest=$3;my$new_path=shift;$new_path="" unless defined$new_path;$new_path =~ s/([^$URI::uric])/ URI::Escape::escape_char($1)/ego;utf8::downgrade($new_path);_check_path($new_path,$$self);$$self .= $new_path .$rest}$2}sub _check_path {my($path,$pre)=@_;my$prefix;if ($pre =~ m,/,){$prefix="/" if length($path)&& $path !~ m,^[/?\#],}else {if ($path =~ m,^//,){Carp::carp("Path starting with double slash is confusing")if $^W}elsif (!length($pre)&& $path =~ m,^[^:/?\#]+:,){Carp::carp("Path might look like scheme, './' prepended")if $^W;$prefix="./"}}substr($_[0],0,0)=$prefix if defined$prefix}sub path_segments {my$self=shift;my$path=$self->path;if (@_){my@arg=@_;for (@arg){if (ref($_)){my@seg=@$_;$seg[0]=~ s/%/%25/g;for (@seg){s/;/%3B/g}$_=join(";",@seg)}else {s/%/%25/g;s/;/%3B/g}s,/,%2F,g}$self->path(join("/",@arg))}return$path unless wantarray;map {/;/ ? $self->_split_segment($_): uri_unescape($_)}split('/',$path,-1)}sub _split_segment {my$self=shift;require URI::_segment;URI::_segment->new(@_)}sub abs {my$self=shift;my$base=shift || Carp::croak("Missing base argument");if (my$scheme=$self->scheme){return$self unless$URI::ABS_ALLOW_RELATIVE_SCHEME;$base=URI->new($base)unless ref$base;return$self unless$scheme eq $base->scheme}$base=URI->new($base)unless ref$base;my$abs=$self->clone;$abs->scheme($base->scheme);return$abs if $$self =~ m,^(?:$URI::scheme_re:)?//,o;$abs->authority($base->authority);my$path=$self->path;return$abs if$path =~ m,^/,;if (!length($path)){my$abs=$base->clone;my$query=$self->query;$abs->query($query)if defined$query;my$fragment=$self->fragment;$abs->fragment($fragment)if defined$fragment;return$abs}my$p=$base->path;$p =~ s,[^/]+$,,;$p .= $path;my@p=split('/',$p,-1);shift(@p)if@p &&!length($p[0]);my$i=1;while ($i < @p){if ($p[$i-1]eq "."){splice(@p,$i-1,1);$i-- if$i > 1}elsif ($p[$i]eq ".." && $p[$i-1]ne ".."){splice(@p,$i-1,2);if ($i > 1){$i--;push(@p,"")if$i==@p}}else {$i++}}$p[-1]="" if@p && $p[-1]eq ".";if ($URI::ABS_REMOTE_LEADING_DOTS){shift@p while@p && $p[0]=~ /^\.\.?$/}$abs->path("/" .join("/",@p));$abs}sub rel {my$self=shift;my$base=shift || Carp::croak("Missing base argument");my$rel=$self->clone;$base=URI->new($base)unless ref$base;my$scheme=$rel->scheme;my$auth=$rel->canonical->authority;my$path=$rel->path;if (!defined($scheme)&&!defined($auth)){return$rel}my$bscheme=$base->scheme;my$bauth=$base->canonical->authority;my$bpath=$base->path;for ($bscheme,$bauth,$auth){$_='' unless defined}unless ($scheme eq $bscheme && $auth eq $bauth){return$rel}for ($path,$bpath){$_="/$_" unless m,^/,}$rel->scheme(undef);$rel->authority(undef);my$li=1;while (1){my$i=index($path,'/',$li);last if$i < 0 || $i!=index($bpath,'/',$li)|| substr($path,$li,$i-$li)ne substr($bpath,$li,$i-$li);$li=$i+1}substr($path,0,$li)='';substr($bpath,0,$li)='';if ($path eq $bpath && defined($rel->fragment)&&!defined($rel->query)){$rel->path("")}else {$path=('../' x $bpath =~ tr|/|/|).$path;$path="./" if$path eq "";$rel->path($path)}$rel}1; URI__GENERIC $fatpacked{"URI/_idna.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'URI__IDNA'; - package URI::_idna;use strict;use warnings;use URI::_punycode qw(decode_punycode encode_punycode);use Carp qw(croak);our$VERSION='5.29';BEGIN {*URI::_idna::_ENV_::JOIN_LEAKS_UTF8_FLAGS="$]" < 5.008_003 ? sub () {1}: sub () {0}}my$ASCII=qr/^[\x00-\x7F]*\z/;sub encode {my$idomain=shift;my@labels=split(/\./,$idomain,-1);my@last_empty;push(@last_empty,pop@labels)if@labels > 1 && $labels[-1]eq "";for (@labels){$_=ToASCII($_)}return eval 'join(".", @labels, @last_empty)' if URI::_idna::_ENV_::JOIN_LEAKS_UTF8_FLAGS;return join(".",@labels,@last_empty)}sub decode {my$domain=shift;return join(".",map ToUnicode($_),split(/\./,$domain,-1))}sub nameprep {my$label=shift;$label=lc($label);return$label}sub check_size {my$label=shift;croak "Label empty" if$label eq "";croak "Label too long" if length($label)> 63;return$label}sub ToASCII {my$label=shift;return check_size($label)if$label =~ $ASCII;$label=nameprep($label);return check_size($label)if$label =~ $ASCII;if ($label =~ /^xn--/){croak "Label starts with ACE prefix"}$label=encode_punycode($label);$label="xn--$label";return check_size($label)}sub ToUnicode {my$label=shift;$label=nameprep($label)unless$label =~ $ASCII;return$label unless$label =~ /^xn--/;my$result=decode_punycode(substr($label,4));my$label2=ToASCII($result);if (lc($label)ne $label2){croak "IDNA does not round-trip: '\L$label\E' vs '$label2'"}return$result}1; + package URI::_idna;use strict;use warnings;use URI::_punycode qw(decode_punycode encode_punycode);use Carp qw(croak);our$VERSION='5.31';BEGIN {*URI::_idna::_ENV_::JOIN_LEAKS_UTF8_FLAGS="$]" < 5.008_003 ? sub () {1}: sub () {0}}my$ASCII=qr/^[\x00-\x7F]*\z/;sub encode {my$idomain=shift;my@labels=split(/\./,$idomain,-1);my@last_empty;push(@last_empty,pop@labels)if@labels > 1 && $labels[-1]eq "";for (@labels){$_=ToASCII($_)}return eval 'join(".", @labels, @last_empty)' if URI::_idna::_ENV_::JOIN_LEAKS_UTF8_FLAGS;return join(".",@labels,@last_empty)}sub decode {my$domain=shift;return join(".",map ToUnicode($_),split(/\./,$domain,-1))}sub nameprep {my$label=shift;$label=lc($label);return$label}sub check_size {my$label=shift;croak "Label empty" if$label eq "";croak "Label too long" if length($label)> 63;return$label}sub ToASCII {my$label=shift;return check_size($label)if$label =~ $ASCII;$label=nameprep($label);return check_size($label)if$label =~ $ASCII;if ($label =~ /^xn--/){croak "Label starts with ACE prefix"}$label=encode_punycode($label);$label="xn--$label";return check_size($label)}sub ToUnicode {my$label=shift;$label=nameprep($label)unless$label =~ $ASCII;return$label unless$label =~ /^xn--/;my$result=decode_punycode(substr($label,4));my$label2=ToASCII($result);if (lc($label)ne $label2){croak "IDNA does not round-trip: '\L$label\E' vs '$label2'"}return$result}1; URI__IDNA $fatpacked{"URI/_ldap.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'URI__LDAP'; - package URI::_ldap;use strict;use warnings;our$VERSION='5.29';use URI::Escape qw(uri_unescape);sub _ldap_elem {my$self=shift;my$elem=shift;my$query=$self->query;my@bits=(split(/\?/,defined($query)? $query : ""),("")x4);my$old=$bits[$elem];if (@_){my$new=shift;$new =~ s/\?/%3F/g;$bits[$elem]=$new;$query=join("?",@bits);$query =~ s/\?+$//;$query=undef unless length($query);$self->query($query)}$old}sub dn {my$old=shift->path(@_);$old =~ s:^/::;uri_unescape($old)}sub attributes {my$self=shift;my$old=_ldap_elem($self,0,@_ ? join(",",map {my$tmp=$_;$tmp =~ s/,/%2C/g;$tmp}@_): ());return$old unless wantarray;map {uri_unescape($_)}split(/,/,$old)}sub _scope {my$self=shift;my$old=_ldap_elem($self,1,@_);return undef unless defined wantarray && defined$old;uri_unescape($old)}sub scope {my$old=&_scope;$old="base" unless length$old;$old}sub _filter {my$self=shift;my$old=_ldap_elem($self,2,@_);return undef unless defined wantarray && defined$old;uri_unescape($old)}sub filter {my$old=&_filter;$old="(objectClass=*)" unless length$old;$old}sub extensions {my$self=shift;my@ext;while (@_){my$key=shift;my$value=shift;push(@ext,join("=",map {$_="" unless defined;s/,/%2C/g;$_}$key,$value))}@ext=join(",",@ext)if@ext;my$old=_ldap_elem($self,3,@ext);return$old unless wantarray;map {uri_unescape($_)}map {/^([^=]+)=(.*)$/}split(/,/,$old)}sub canonical {my$self=shift;my$other=$self->_nonldap_canonical;$other=$other->clone if$other==$self;$other->dn(_normalize_dn($other->dn));$other->attributes(map lc,$other->attributes);my$old_scope=$other->scope;my$new_scope=lc($old_scope);$new_scope="" if$new_scope eq "base";$other->scope($new_scope)if$new_scope ne $old_scope;my$old_filter=$other->filter;$other->filter("")if lc($old_filter)eq "(objectclass=*)" || lc($old_filter)eq "objectclass=*";my@ext=$other->extensions;for (my$i=0;$i < @ext;$i += 2){my$etype=$ext[$i]=lc($ext[$i]);if ($etype =~ /^!?bindname$/){$ext[$i+1]=_normalize_dn($ext[$i+1])}}$other->extensions(@ext)if@ext;$other}sub _normalize_dn {my$dn=shift;return$dn;my@dn=split(/([+,])/,$dn);for (@dn){s/^([a-zA-Z]+=)/lc($1)/e}join("",@dn)}1; + package URI::_ldap;use strict;use warnings;our$VERSION='5.31';use URI::Escape qw(uri_unescape);sub _ldap_elem {my$self=shift;my$elem=shift;my$query=$self->query;my@bits=(split(/\?/,defined($query)? $query : ""),("")x4);my$old=$bits[$elem];if (@_){my$new=shift;$new =~ s/\?/%3F/g;$bits[$elem]=$new;$query=join("?",@bits);$query =~ s/\?+$//;$query=undef unless length($query);$self->query($query)}$old}sub dn {my$old=shift->path(@_);$old =~ s:^/::;uri_unescape($old)}sub attributes {my$self=shift;my$old=_ldap_elem($self,0,@_ ? join(",",map {my$tmp=$_;$tmp =~ s/,/%2C/g;$tmp}@_): ());return$old unless wantarray;map {uri_unescape($_)}split(/,/,$old)}sub _scope {my$self=shift;my$old=_ldap_elem($self,1,@_);return undef unless defined wantarray && defined$old;uri_unescape($old)}sub scope {my$old=&_scope;$old="base" unless length$old;$old}sub _filter {my$self=shift;my$old=_ldap_elem($self,2,@_);return undef unless defined wantarray && defined$old;uri_unescape($old)}sub filter {my$old=&_filter;$old="(objectClass=*)" unless length$old;$old}sub extensions {my$self=shift;my@ext;while (@_){my$key=shift;my$value=shift;push(@ext,join("=",map {$_="" unless defined;s/,/%2C/g;$_}$key,$value))}@ext=join(",",@ext)if@ext;my$old=_ldap_elem($self,3,@ext);return$old unless wantarray;map {uri_unescape($_)}map {/^([^=]+)=(.*)$/}split(/,/,$old)}sub canonical {my$self=shift;my$other=$self->_nonldap_canonical;$other=$other->clone if$other==$self;$other->dn(_normalize_dn($other->dn));$other->attributes(map lc,$other->attributes);my$old_scope=$other->scope;my$new_scope=lc($old_scope);$new_scope="" if$new_scope eq "base";$other->scope($new_scope)if$new_scope ne $old_scope;my$old_filter=$other->filter;$other->filter("")if lc($old_filter)eq "(objectclass=*)" || lc($old_filter)eq "objectclass=*";my@ext=$other->extensions;for (my$i=0;$i < @ext;$i += 2){my$etype=$ext[$i]=lc($ext[$i]);if ($etype =~ /^!?bindname$/){$ext[$i+1]=_normalize_dn($ext[$i+1])}}$other->extensions(@ext)if@ext;$other}sub _normalize_dn {my$dn=shift;return$dn;my@dn=split(/([+,])/,$dn);for (@dn){s/^([a-zA-Z]+=)/lc($1)/e}join("",@dn)}1; URI__LDAP $fatpacked{"URI/_login.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'URI__LOGIN'; - package URI::_login;use strict;use warnings;use parent qw(URI::_server URI::_userpass);our$VERSION='5.29';1; + package URI::_login;use strict;use warnings;use parent qw(URI::_server URI::_userpass);our$VERSION='5.31';1; URI__LOGIN $fatpacked{"URI/_punycode.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'URI__PUNYCODE'; - package URI::_punycode;use strict;use warnings;our$VERSION='5.29';use Exporter 'import';our@EXPORT=qw(encode_punycode decode_punycode);use integer;our$DEBUG=0;use constant BASE=>36;use constant TMIN=>1;use constant TMAX=>26;use constant SKEW=>38;use constant DAMP=>700;use constant INITIAL_BIAS=>72;use constant INITIAL_N=>128;my$Delimiter=chr 0x2D;my$BasicRE=qr/[\x00-\x7f]/;sub _croak {require Carp;Carp::croak(@_)}sub _digit_value {my$code=shift;return ord($code)- ord("A")if$code =~ /[A-Z]/;return ord($code)- ord("a")if$code =~ /[a-z]/;return ord($code)- ord("0")+ 26 if$code =~ /[0-9]/;return}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 {my($delta,$numpoints,$firsttime)=@_;$delta=$firsttime ? $delta / DAMP : $delta / 2;$delta += $delta / $numpoints;my$k=0;while ($delta > ((BASE - TMIN)* TMAX)/ 2){$delta /= BASE - TMIN;$k += BASE}return$k + (((BASE - TMIN + 1)* $delta)/ ($delta + SKEW))}sub decode_punycode {my$code=shift;my$n=INITIAL_N;my$i=0;my$bias=INITIAL_BIAS;my@output;if ($code =~ s/(.*)$Delimiter//o){push@output,map ord,split //,$1;return _croak('non-basic code point')unless $1 =~ /^$BasicRE*$/o}while ($code){my$oldi=$i;my$w=1;LOOP: for (my$k=BASE;1;$k += BASE){my$cp=substr($code,0,1,'');my$digit=_digit_value($cp);defined$digit or return _croak("invalid punycode input");$i += $digit * $w;my$t=($k <= $bias)? TMIN : ($k >= $bias + TMAX)? TMAX : $k - $bias;last LOOP if$digit < $t;$w *= (BASE - $t)}$bias=_adapt($i - $oldi,@output + 1,$oldi==0);warn "bias becomes $bias" if$DEBUG;$n += $i / (@output + 1);$i=$i % (@output + 1);splice(@output,$i,0,$n);warn join " ",map sprintf('%04x',$_),@output if$DEBUG;$i++}return join '',map chr,@output}sub encode_punycode {my$input=shift;my@input=split //,$input;my$n=INITIAL_N;my$delta=0;my$bias=INITIAL_BIAS;my@output;my@basic=grep /$BasicRE/,@input;my$h=my$b=@basic;push@output,@basic;push@output,$Delimiter if$b && $h < @input;warn "basic codepoints: (@output)" if$DEBUG;while ($h < @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;for my$i (@input){my$c=ord($i);$delta++ if$c < $n;if ($c==$n){my$q=$delta;LOOP: for (my$k=BASE;1;$k += BASE){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)));push@output,chr($cp);$q=($q - $t)/ (BASE - $t)}push@output,chr(_code_point($q));$bias=_adapt($delta,$h + 1,$h==$b);warn "bias becomes $bias" if$DEBUG;$delta=0;$h++}}$delta++;$n++}return join '',@output}sub _min {my$min=shift;for (@_){$min=$_ if $_ <= $min}return$min}1; + package URI::_punycode;use strict;use warnings;our$VERSION='5.31';use Exporter 'import';our@EXPORT=qw(encode_punycode decode_punycode);use integer;our$DEBUG=0;use constant BASE=>36;use constant TMIN=>1;use constant TMAX=>26;use constant SKEW=>38;use constant DAMP=>700;use constant INITIAL_BIAS=>72;use constant INITIAL_N=>128;my$Delimiter=chr 0x2D;my$BasicRE=qr/[\x00-\x7f]/;sub _croak {require Carp;Carp::croak(@_)}sub _digit_value {my$code=shift;return ord($code)- ord("A")if$code =~ /[A-Z]/;return ord($code)- ord("a")if$code =~ /[a-z]/;return ord($code)- ord("0")+ 26 if$code =~ /[0-9]/;return}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 {my($delta,$numpoints,$firsttime)=@_;$delta=$firsttime ? $delta / DAMP : $delta / 2;$delta += $delta / $numpoints;my$k=0;while ($delta > ((BASE - TMIN)* TMAX)/ 2){$delta /= BASE - TMIN;$k += BASE}return$k + (((BASE - TMIN + 1)* $delta)/ ($delta + SKEW))}sub decode_punycode {my$code=shift;my$n=INITIAL_N;my$i=0;my$bias=INITIAL_BIAS;my@output;if ($code =~ s/(.*)$Delimiter//o){push@output,map ord,split //,$1;return _croak('non-basic code point')unless $1 =~ /^$BasicRE*$/o}while ($code){my$oldi=$i;my$w=1;LOOP: for (my$k=BASE;1;$k += BASE){my$cp=substr($code,0,1,'');my$digit=_digit_value($cp);defined$digit or return _croak("invalid punycode input");$i += $digit * $w;my$t=($k <= $bias)? TMIN : ($k >= $bias + TMAX)? TMAX : $k - $bias;last LOOP if$digit < $t;$w *= (BASE - $t)}$bias=_adapt($i - $oldi,@output + 1,$oldi==0);warn "bias becomes $bias" if$DEBUG;$n += $i / (@output + 1);$i=$i % (@output + 1);splice(@output,$i,0,$n);warn join " ",map sprintf('%04x',$_),@output if$DEBUG;$i++}return join '',map chr,@output}sub encode_punycode {my$input=shift;my@input=split //,$input;my$n=INITIAL_N;my$delta=0;my$bias=INITIAL_BIAS;my@output;my@basic=grep /$BasicRE/,@input;my$h=my$b=@basic;push@output,@basic;push@output,$Delimiter if$b && $h < @input;warn "basic codepoints: (@output)" if$DEBUG;while ($h < @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;for my$i (@input){my$c=ord($i);$delta++ if$c < $n;if ($c==$n){my$q=$delta;LOOP: for (my$k=BASE;1;$k += BASE){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)));push@output,chr($cp);$q=($q - $t)/ (BASE - $t)}push@output,chr(_code_point($q));$bias=_adapt($delta,$h + 1,$h==$b);warn "bias becomes $bias" if$DEBUG;$delta=0;$h++}}$delta++;$n++}return join '',@output}sub _min {my$min=shift;for (@_){$min=$_ if $_ <= $min}return$min}1; URI__PUNYCODE $fatpacked{"URI/_query.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'URI__QUERY'; - package URI::_query;use strict;use warnings;use URI ();use URI::Escape qw(uri_unescape);use Scalar::Util ();our$VERSION='5.29';sub query {my$self=shift;$$self =~ m,^([^?\#]*)(?:\?([^\#]*))?(.*)$,s or die;if (@_){my$q=shift;$$self=$1;if (defined$q){$q =~ s/([^$URI::uric])/ URI::Escape::escape_char($1)/ego;utf8::downgrade($q);$$self .= "?$q"}$$self .= $3}$2}sub query_form {my$self=shift;my$old=$self->query;if (@_){my$delim;my$r=$_[0];if (_is_array($r)){$delim=$_[1];@_=@$r}elsif (ref($r)eq "HASH"){$delim=$_[1];@_=map {$_=>$r->{$_}}sort keys %$r}$delim=pop if @_ % 2;my@query;while (my($key,$vals)=splice(@_,0,2)){$key='' unless defined$key;$key =~ s/([;\/?:@&=+,\$\[\]%])/ URI::Escape::escape_char($1)/eg;$key =~ s/ /+/g;$vals=[_is_array($vals)? @$vals : $vals];for my$val (@$vals){if (defined$val){$val =~ s/([;\/?:@&=+,\$\[\]%])/ URI::Escape::escape_char($1)/eg;$val =~ s/ /+/g;push(@query,"$key=$val")}else {push(@query,$key)}}}if (@query){unless ($delim){$delim=$1 if$old && $old =~ /([&;])/;$delim ||= $URI::DEFAULT_QUERY_FORM_DELIMITER || "&"}$self->query(join($delim,@query))}else {$self->query(undef)}}return if!defined($old)||!length($old)||!defined(wantarray);return unless$old =~ /=/;map {(defined)? do {s/\+/ /g;uri_unescape($_)}: undef}map {/=/ ? split(/=/,$_,2): ($_=>undef)}split(/[&;]/,$old)}sub query_keywords {my$self=shift;my$old=$self->query;if (@_){my@copy=@_;@copy=@{$copy[0]}if@copy==1 && _is_array($copy[0]);for (@copy){s/([;\/?:@&=+,\$\[\]%])/ URI::Escape::escape_char($1)/eg}$self->query(@copy ? join('+',@copy): undef)}return if!defined($old)||!defined(wantarray);return if$old =~ /=/;map {uri_unescape($_)}split(/\+/,$old,-1)}sub equery {goto&query}sub query_param {my$self=shift;my@old=$self->query_form;if (@_==0){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 {_is_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){@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 {_is_array($_)? @$_ : $_}@_;$self->query_form($self->query_form,$key=>\@vals);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 _is_array($_);push(@$_,$v)}}else {$hash{$k}=$v}}return \%hash}sub _is_array {return(defined($_[0])&& (Scalar::Util::reftype($_[0])|| '')eq "ARRAY" &&!(Scalar::Util::blessed($_[0])&& overload::Method($_[0],'""')))}1; + package URI::_query;use strict;use warnings;use URI ();use URI::Escape qw(uri_unescape);use Scalar::Util ();our$VERSION='5.31';sub query {my$self=shift;$$self =~ m,^([^?\#]*)(?:\?([^\#]*))?(.*)$,s or die;if (@_){my$q=shift;$$self=$1;if (defined$q){$q =~ s/([^$URI::uric])/ URI::Escape::escape_char($1)/ego;utf8::downgrade($q);$$self .= "?$q"}$$self .= $3}$2}sub query_form {my$self=shift;my$old=$self->query;if (@_){my$delim;my$r=$_[0];if (_is_array($r)){$delim=$_[1];@_=@$r}elsif (ref($r)eq "HASH"){$delim=$_[1];@_=map {$_=>$r->{$_}}sort keys %$r}$delim=pop if @_ % 2;my@query;while (my($key,$vals)=splice(@_,0,2)){$key='' unless defined$key;$key =~ s/([;\/?:@&=+,\$\[\]%])/ URI::Escape::escape_char($1)/eg;$key =~ s/ /+/g;$vals=[_is_array($vals)? @$vals : $vals];for my$val (@$vals){if (defined$val){$val =~ s/([;\/?:@&=+,\$\[\]%])/ URI::Escape::escape_char($1)/eg;$val =~ s/ /+/g;push(@query,"$key=$val")}else {push(@query,$key)}}}if (@query){unless ($delim){$delim=$1 if$old && $old =~ /([&;])/;$delim ||= $URI::DEFAULT_QUERY_FORM_DELIMITER || "&"}$self->query(join($delim,@query))}else {$self->query(undef)}}return if!defined($old)||!length($old)||!defined(wantarray);return unless$old =~ /=/;map {(defined)? do {s/\+/ /g;uri_unescape($_)}: undef}map {/=/ ? split(/=/,$_,2): ($_=>undef)}split(/[&;]/,$old)}sub query_keywords {my$self=shift;my$old=$self->query;if (@_){my@copy=@_;@copy=@{$copy[0]}if@copy==1 && _is_array($copy[0]);for (@copy){s/([;\/?:@&=+,\$\[\]%])/ URI::Escape::escape_char($1)/eg}$self->query(@copy ? join('+',@copy): undef)}return if!defined($old)||!defined(wantarray);return if$old =~ /=/;map {uri_unescape($_)}split(/\+/,$old,-1)}sub equery {goto&query}sub query_param {my$self=shift;my@old=$self->query_form;if (@_==0){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 {_is_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){@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 {_is_array($_)? @$_ : $_}@_;$self->query_form($self->query_form,$key=>\@vals);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 _is_array($_);push(@$_,$v)}}else {$hash{$k}=$v}}return \%hash}sub _is_array {return(defined($_[0])&& (Scalar::Util::reftype($_[0])|| '')eq "ARRAY" &&!(Scalar::Util::blessed($_[0])&& overload::Method($_[0],'""')))}1; URI__QUERY $fatpacked{"URI/_segment.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'URI__SEGMENT'; - package URI::_segment;use strict;use warnings;use URI::Escape qw(uri_unescape);use overload '""'=>sub {$_[0]->[0]},fallback=>1;our$VERSION='5.29';sub new {my$class=shift;my@segment=split(';',shift,-1);$segment[0]=uri_unescape($segment[0]);bless \@segment,$class}1; + package URI::_segment;use strict;use warnings;use URI::Escape qw(uri_unescape);use overload '""'=>sub {$_[0]->[0]},fallback=>1;our$VERSION='5.31';sub new {my$class=shift;my@segment=split(';',shift,-1);$segment[0]=uri_unescape($segment[0]);bless \@segment,$class}1; URI__SEGMENT $fatpacked{"URI/_server.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'URI__SERVER'; - package URI::_server;use strict;use warnings;use parent 'URI::_generic';use URI::Escape qw(uri_unescape);our$VERSION='5.29';sub _uric_escape {my($class,$str)=@_;if ($str =~ m,^((?:$URI::scheme_re:)?)//([^/?\#]*)(.*)$,os){my($scheme,$host,$rest)=($1,$2,$3);my$ui=$host =~ s/(.*@)// ? $1 : "";my$port=$host =~ s/(:\d+)\z// ? $1 : "";if (_host_escape($host)){$str="$scheme//$ui$host$port$rest"}}return$class->SUPER::_uric_escape($str)}sub _host_escape {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])};return 0 if $@;return 1}sub as_iri {my$self=shift;my$str=$self->SUPER::as_iri;if ($str =~ /\bxn--/){if ($str =~ m,^((?:$URI::scheme_re:)?)//([^/?\#]*)(.*)$,os){my($scheme,$host,$rest)=($1,$2,$3);my$ui=$host =~ s/(.*@)// ? $1 : "";my$port=$host =~ s/(:\d+)\z// ? $1 : "";require URI::_idna;$host=URI::_idna::decode($host);$str="$scheme//$ui$host$port$rest"}}return$str}sub userinfo {my$self=shift;my$old=$self->authority;if (@_){my$new=$old;$new="" unless defined$new;$new =~ s/.*@//;my$ui=shift;if (defined$ui){$ui =~ s/([^$URI::uric4user])/ URI::Escape::escape_char($1)/ego;$new="$ui\@$new"}$self->authority($new)}return undef if!defined($old)|| $old !~ /(.*)@/;return $1}sub host {my$self=shift;my$old=$self->authority;if (@_){my$tmp=$old;$tmp="" unless defined$tmp;my$ui=($tmp =~ /(.*@)/)? $1 : "";my$port=($tmp =~ /(:\d+)$/)? $1 : "";my$new=shift;$new="" unless defined$new;if (length$new){$new =~ s/[@]/%40/g;if ($new =~ /^[^:]*:\d*\z/ || $new =~ /]:\d*\z/){$new =~ s/(:\d*)\z// || die "Assert";$port=$1}$new="[$new]" if$new =~ /:/ && $new !~ /^\[/;_host_escape($new)}$self->authority("$ui$new$port")}return undef unless defined$old;$old =~ s/.*@//;$old =~ s/:\d+$//;$old =~ s{^\[(.*)\]$}{$1};return uri_unescape($old)}sub ihost {my$self=shift;my$old=$self->host(@_);if ($old =~ /(^|\.)xn--/){require URI::_idna;$old=URI::_idna::decode($old)}return$old}sub _port {my$self=shift;my$old=$self->authority;if (@_){my$new=$old;$new =~ s/:\d*$//;my$port=shift;$new .= ":$port" if defined$port;$self->authority($new)}return $1 if defined($old)&& $old =~ /:(\d*)$/;return}sub port {my$self=shift;my$port=$self->_port(@_);$port=$self->default_port if!defined($port)|| $port eq "";$port}sub host_port {my$self=shift;my$old=$self->authority;$self->host(shift)if @_;return undef unless defined$old;$old =~ s/.*@//;$old =~ s/:$//;$old .= ":" .$self->port unless$old =~ /:\d+$/;$old}sub default_port {undef}sub canonical {my$self=shift;my$other=$self->SUPER::canonical;my$host=$other->host || "";my$port=$other->_port;my$uc_host=$host =~ /[A-Z]/;my$def_port=defined($port)&& ($port eq "" || $port==$self->default_port);if ($uc_host || $def_port){$other=$other->clone if$other==$self;$other->host(lc$host)if$uc_host;$other->port(undef)if$def_port}$other}1; + package URI::_server;use strict;use warnings;use parent 'URI::_generic';use URI::Escape qw(uri_unescape);our$VERSION='5.31';sub _uric_escape {my($class,$str)=@_;if ($str =~ m,^((?:$URI::scheme_re:)?)//([^/?\#]*)(.*)$,os){my($scheme,$host,$rest)=($1,$2,$3);my$ui=$host =~ s/(.*@)// ? $1 : "";my$port=$host =~ s/(:\d+)\z// ? $1 : "";if (_host_escape($host)){$str="$scheme//$ui$host$port$rest"}}return$class->SUPER::_uric_escape($str)}sub _host_escape {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])};return 0 if $@;return 1}sub as_iri {my$self=shift;my$str=$self->SUPER::as_iri;if ($str =~ /\bxn--/){if ($str =~ m,^((?:$URI::scheme_re:)?)//([^/?\#]*)(.*)$,os){my($scheme,$host,$rest)=($1,$2,$3);my$ui=$host =~ s/(.*@)// ? $1 : "";my$port=$host =~ s/(:\d+)\z// ? $1 : "";require URI::_idna;$host=URI::_idna::decode($host);$str="$scheme//$ui$host$port$rest"}}return$str}sub userinfo {my$self=shift;my$old=$self->authority;if (@_){my$new=$old;$new="" unless defined$new;$new =~ s/.*@//;my$ui=shift;if (defined$ui){$ui =~ s/([^$URI::uric4user])/ URI::Escape::escape_char($1)/ego;$new="$ui\@$new"}$self->authority($new)}return undef if!defined($old)|| $old !~ /(.*)@/;return $1}sub host {my$self=shift;my$old=$self->authority;if (@_){my$tmp=$old;$tmp="" unless defined$tmp;my$ui=($tmp =~ /(.*@)/)? $1 : "";my$port=($tmp =~ /(:\d+)$/)? $1 : "";my$new=shift;$new="" unless defined$new;if (length$new){$new =~ s/[@]/%40/g;if ($new =~ /^[^:]*:\d*\z/ || $new =~ /]:\d*\z/){$new =~ s/(:\d*)\z// || die "Assert";$port=$1}$new="[$new]" if$new =~ /:/ && $new !~ /^\[/;_host_escape($new)}$self->authority("$ui$new$port")}return undef unless defined$old;$old =~ s/.*@//;$old =~ s/:\d+$//;$old =~ s{^\[(.*)\]$}{$1};return uri_unescape($old)}sub ihost {my$self=shift;my$old=$self->host(@_);if ($old =~ /(^|\.)xn--/){require URI::_idna;$old=URI::_idna::decode($old)}return$old}sub _port {my$self=shift;my$old=$self->authority;if (@_){my$new=$old;$new =~ s/:\d*$//;my$port=shift;$new .= ":$port" if defined$port;$self->authority($new)}return $1 if defined($old)&& $old =~ /:(\d*)$/;return}sub port {my$self=shift;my$port=$self->_port(@_);$port=$self->default_port if!defined($port)|| $port eq "";$port}sub host_port {my$self=shift;my$old=$self->authority;$self->host(shift)if @_;return undef unless defined$old;$old =~ s/.*@//;$old =~ s/:$//;$old .= ":" .$self->port unless$old =~ /:\d+$/;$old}sub default_port {undef}sub canonical {my$self=shift;my$other=$self->SUPER::canonical;my$host=$other->host || "";my$port=$other->_port;my$uc_host=$host =~ /[A-Z]/;my$def_port=defined($port)&& ($port eq "" || $port==$self->default_port);if ($uc_host || $def_port){$other=$other->clone if$other==$self;$other->host(lc$host)if$uc_host;$other->port(undef)if$def_port}$other}1; URI__SERVER $fatpacked{"URI/_userpass.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'URI__USERPASS'; - package URI::_userpass;use strict;use warnings;use URI::Escape qw(uri_unescape);our$VERSION='5.29';sub user {my$self=shift;my$info=$self->userinfo;if (@_){my$new=shift;my$pass=defined($info)? $info : "";$pass =~ s/^[^:]*//;if (!defined($new)&&!length($pass)){$self->userinfo(undef)}else {$new="" unless defined($new);$new =~ s/%/%25/g;$new =~ s/:/%3A/g;$self->userinfo("$new$pass")}}return undef unless defined$info;$info =~ s/:.*//;uri_unescape($info)}sub password {my$self=shift;my$info=$self->userinfo;if (@_){my$new=shift;my$user=defined($info)? $info : "";$user =~ s/:.*//;if (!defined($new)){$self->userinfo(length$user ? $user : undef)}else {$new="" unless defined($new);$new =~ s/%/%25/g;$self->userinfo("$user:$new")}}return undef unless defined$info;return undef unless$info =~ s/^[^:]*://;uri_unescape($info)}1; + package URI::_userpass;use strict;use warnings;use URI::Escape qw(uri_unescape);our$VERSION='5.31';sub user {my$self=shift;my$info=$self->userinfo;if (@_){my$new=shift;my$pass=defined($info)? $info : "";$pass =~ s/^[^:]*//;if (!defined($new)&&!length($pass)){$self->userinfo(undef)}else {$new="" unless defined($new);$new =~ s/%/%25/g;$new =~ s/:/%3A/g;$self->userinfo("$new$pass")}}return undef unless defined$info;$info =~ s/:.*//;uri_unescape($info)}sub password {my$self=shift;my$info=$self->userinfo;if (@_){my$new=shift;my$user=defined($info)? $info : "";$user =~ s/:.*//;if (!defined($new)){$self->userinfo(length$user ? $user : undef)}else {$new="" unless defined($new);$new =~ s/%/%25/g;$self->userinfo("$user:$new")}}return undef unless defined$info;return undef unless$info =~ s/^[^:]*://;uri_unescape($info)}1; URI__USERPASS $fatpacked{"URI/data.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'URI_DATA'; - package URI::data;use strict;use warnings;use parent 'URI';our$VERSION='5.29';use MIME::Base64 qw(decode_base64 encode_base64);use URI::Escape qw(uri_unescape);sub media_type {my$self=shift;my$opaque=$self->opaque;$opaque =~ /^([^,]*),?/ or die;my$old=$1;my$base64;$base64=$1 if$old =~ s/(;base64)$//i;if (@_){my$new=shift;$new="" unless defined$new;$new =~ s/%/%25/g;$new =~ s/,/%2C/g;$base64="" unless defined$base64;$opaque =~ s/^[^,]*,?/$new$base64,/;$self->opaque($opaque)}return uri_unescape($old)if$old;"text/plain;charset=US-ASCII"}sub data {my$self=shift;my($enc,$data)=split(",",$self->opaque,2);unless (defined$data){$data="";$enc="" unless defined$enc}my$base64=($enc =~ /;base64$/i);if (@_){$enc =~ s/;base64$//i if$base64;my$new=shift;$new="" unless defined$new;my$uric_count=_uric_count($new);my$urienc_len=$uric_count + (length($new)- $uric_count)* 3;my$base64_len=int((length($new)+2)/ 3)* 4;$base64_len += 7;if ($base64_len < $urienc_len || $_[0]){$enc .= ";base64";$new=encode_base64($new,"")}else {$new =~ s/%/%25/g}$self->opaque("$enc,$new")}return unless defined wantarray;$data=uri_unescape($data);return$base64 ? decode_base64($data): $data}my$ENC=$URI::uric;$ENC =~ s/%//;eval <opaque;$opaque =~ /^([^,]*),?/ or die;my$old=$1;my$base64;$base64=$1 if$old =~ s/(;base64)$//i;if (@_){my$new=shift;$new="" unless defined$new;$new =~ s/%/%25/g;$new =~ s/,/%2C/g;$base64="" unless defined$base64;$opaque =~ s/^[^,]*,?/$new$base64,/;$self->opaque($opaque)}return uri_unescape($old)if$old;"text/plain;charset=US-ASCII"}sub data {my$self=shift;my($enc,$data)=split(",",$self->opaque,2);unless (defined$data){$data="";$enc="" unless defined$enc}my$base64=($enc =~ /;base64$/i);if (@_){$enc =~ s/;base64$//i if$base64;my$new=shift;$new="" unless defined$new;my$uric_count=_uric_count($new);my$urienc_len=$uric_count + (length($new)- $uric_count)* 3;my$base64_len=int((length($new)+2)/ 3)* 4;$base64_len += 7;if ($base64_len < $urienc_len || $_[0]){$enc .= ";base64";$new=encode_base64($new,"")}else {$new =~ s/%/%25/g}$self->opaque("$enc,$new")}return unless defined wantarray;$data=uri_unescape($data);return$base64 ? decode_base64($data): $data}my$ENC=$URI::uric;$ENC =~ s/%//;eval <"OS2",mac=>"Mac",MacOS=>"Mac",MSWin32=>"Win32",win32=>"Win32",msdos=>"FAT",dos=>"FAT",qnx=>"QNX",);sub os_class {my($OS)=shift || $^O;my$class="URI::file::" .($OS_CLASS{$OS}|| "Unix");no strict 'refs';unless (%{"$class\::"}){eval "require $class";die $@ if $@}$class}sub host {uri_unescape(shift->authority(@_))}sub new {my($class,$path,$os)=@_;os_class($os)->new($path)}sub new_abs {my$class=shift;my$file=$class->new(@_);return$file->abs($class->cwd)unless $$file =~ /^file:/;$file}sub cwd {my$class=shift;require Cwd;my$cwd=Cwd::cwd();$cwd=VMS::Filespec::unixpath($cwd)if $^O eq 'VMS';$cwd=$class->new($cwd);$cwd .= "/" unless substr($cwd,-1,1)eq "/";$cwd}sub canonical {my$self=shift;my$other=$self->SUPER::canonical;my$scheme=$other->scheme;my$auth=$other->authority;return$other if!defined($scheme)&&!defined($auth);if (!defined($auth)|| $auth eq "" || lc($auth)eq "localhost" || (defined($DEFAULT_AUTHORITY)&& lc($auth)eq lc($DEFAULT_AUTHORITY))){if ((defined($auth)|| defined($DEFAULT_AUTHORITY))&& (!defined($auth)||!defined($DEFAULT_AUTHORITY)|| $auth ne $DEFAULT_AUTHORITY)){$other=$other->clone if$self==$other;$other->authority($DEFAULT_AUTHORITY)}}$other}sub file {my($self,$os)=@_;os_class($os)->file($self)}sub dir {my($self,$os)=@_;os_class($os)->dir($self)}1; + package URI::file;use strict;use warnings;use parent 'URI::_generic';our$VERSION='5.31';use URI::Escape qw(uri_unescape);our$DEFAULT_AUTHORITY="";our%OS_CLASS=(os2=>"OS2",mac=>"Mac",MacOS=>"Mac",MSWin32=>"Win32",win32=>"Win32",msdos=>"FAT",dos=>"FAT",qnx=>"QNX",);sub os_class {my($OS)=shift || $^O;my$class="URI::file::" .($OS_CLASS{$OS}|| "Unix");no strict 'refs';unless (%{"$class\::"}){eval "require $class";die $@ if $@}$class}sub host {uri_unescape(shift->authority(@_))}sub new {my($class,$path,$os)=@_;os_class($os)->new($path)}sub new_abs {my$class=shift;my$file=$class->new(@_);return$file->abs($class->cwd)unless $$file =~ /^file:/;$file}sub cwd {my$class=shift;require Cwd;my$cwd=Cwd::cwd();$cwd=VMS::Filespec::unixpath($cwd)if $^O eq 'VMS';$cwd=$class->new($cwd);$cwd .= "/" unless substr($cwd,-1,1)eq "/";$cwd}sub canonical {my$self=shift;my$other=$self->SUPER::canonical;my$scheme=$other->scheme;my$auth=$other->authority;return$other if!defined($scheme)&&!defined($auth);if (!defined($auth)|| $auth eq "" || lc($auth)eq "localhost" || (defined($DEFAULT_AUTHORITY)&& lc($auth)eq lc($DEFAULT_AUTHORITY))){if ((defined($auth)|| defined($DEFAULT_AUTHORITY))&& (!defined($auth)||!defined($DEFAULT_AUTHORITY)|| $auth ne $DEFAULT_AUTHORITY)){$other=$other->clone if$self==$other;$other->authority($DEFAULT_AUTHORITY)}}$other}sub file {my($self,$os)=@_;os_class($os)->file($self)}sub dir {my($self,$os)=@_;os_class($os)->dir($self)}1; URI_FILE $fatpacked{"URI/file/Base.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'URI_FILE_BASE'; - package URI::file::Base;use strict;use warnings;use URI::Escape ();our$VERSION='5.29';sub new {my$class=shift;my$path=shift;$path="" unless defined$path;my($auth,$escaped_auth,$escaped_path);($auth,$escaped_auth)=$class->_file_extract_authority($path);($path,$escaped_path)=$class->_file_extract_path($path);if (defined$auth){$auth =~ s,%,%25,g unless$escaped_auth;$auth =~ s,([/?\#]), URI::Escape::escape_char($1),eg;$auth="//$auth";if (defined$path){$path="/$path" unless substr($path,0,1)eq "/"}else {$path=""}}else {return undef unless defined$path;$auth=""}$path =~ s,([%;?]), URI::Escape::escape_char($1),eg unless$escaped_path;$path =~ s/\#/%23/g;my$uri=$auth .$path;$uri="file:$uri" if substr($uri,0,1)eq "/";URI->new($uri,"file")}sub _file_extract_authority {my($class,$path)=@_;return undef unless$class->_file_is_absolute($path);return$URI::file::DEFAULT_AUTHORITY}sub _file_extract_path {return undef}sub _file_is_absolute {return 0}sub _file_is_localhost {shift;my$host=lc(shift);return 1 if$host eq "localhost";eval {require Net::Domain;lc(Net::Domain::hostfqdn()|| '')eq $host || lc(Net::Domain::hostname()|| '')eq $host}}sub file {undef}sub dir {my$self=shift;$self->file(@_)}1; + package URI::file::Base;use strict;use warnings;use URI::Escape ();our$VERSION='5.31';sub new {my$class=shift;my$path=shift;$path="" unless defined$path;my($auth,$escaped_auth,$escaped_path);($auth,$escaped_auth)=$class->_file_extract_authority($path);($path,$escaped_path)=$class->_file_extract_path($path);if (defined$auth){$auth =~ s,%,%25,g unless$escaped_auth;$auth =~ s,([/?\#]), URI::Escape::escape_char($1),eg;$auth="//$auth";if (defined$path){$path="/$path" unless substr($path,0,1)eq "/"}else {$path=""}}else {return undef unless defined$path;$auth=""}$path =~ s,([%;?]), URI::Escape::escape_char($1),eg unless$escaped_path;$path =~ s/\#/%23/g;my$uri=$auth .$path;$uri="file:$uri" if substr($uri,0,1)eq "/";URI->new($uri,"file")}sub _file_extract_authority {my($class,$path)=@_;return undef unless$class->_file_is_absolute($path);return$URI::file::DEFAULT_AUTHORITY}sub _file_extract_path {return undef}sub _file_is_absolute {return 0}sub _file_is_localhost {shift;my$host=lc(shift);return 1 if$host eq "localhost";eval {require Net::Domain;lc(Net::Domain::hostfqdn()|| '')eq $host || lc(Net::Domain::hostname()|| '')eq $host}}sub file {undef}sub dir {my$self=shift;$self->file(@_)}1; URI_FILE_BASE $fatpacked{"URI/file/FAT.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'URI_FILE_FAT'; - package URI::file::FAT;use strict;use warnings;use parent 'URI::file::Win32';our$VERSION='5.29';sub fix_path {shift;for (@_){my@p=map uc,split(/\./,$_,-1);return if@p > 2;@p=("")unless@p;$_=substr($p[0],0,8);if (@p > 1){my$ext=substr($p[1],0,3);$_ .= ".$ext" if length$ext}}1}1; + package URI::file::FAT;use strict;use warnings;use parent 'URI::file::Win32';our$VERSION='5.31';sub fix_path {shift;for (@_){my@p=map uc,split(/\./,$_,-1);return if@p > 2;@p=("")unless@p;$_=substr($p[0],0,8);if (@p > 1){my$ext=substr($p[1],0,3);$_ .= ".$ext" if length$ext}}1}1; URI_FILE_FAT $fatpacked{"URI/file/Mac.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'URI_FILE_MAC'; - package URI::file::Mac;use strict;use warnings;use parent 'URI::file::Base';use URI::Escape qw(uri_unescape);our$VERSION='5.29';sub _file_extract_path {my$class=shift;my$path=shift;my@pre;if ($path =~ s/^(:+)//){if (length($1)==1){@pre=(".")unless length($path)}else {@pre=("..")x (length($1)- 1)}}else {$pre[0]=""}my$isdir=($path =~ s/:$//);$path =~ s,([%/;]), URI::Escape::escape_char($1),eg;my@path=split(/:/,$path,-1);for (@path){if ($_ eq "." || $_ eq ".."){$_="%2E" x length($_)}$_=".." unless length($_)}push (@path,"")if$isdir;(join("/",@pre,@path),1)}sub file {my$class=shift;my$uri=shift;my@path;my$auth=$uri->authority;if (defined$auth){if (lc($auth)ne "localhost" && $auth ne ""){my$u_auth=uri_unescape($auth);if (!$class->_file_is_localhost($u_auth)){@path=("",$auth)}}}my@ps=split("/",$uri->path,-1);shift@ps if@path;push(@path,@ps);my$pre="";if (!@path){return}elsif ($path[0]eq ""){shift(@path);if (@path==1){return if$path[0]eq "";push(@path,"")}@ps=@path;@path=();my$part;for (@ps){next if $_ eq ".";$part=$_ eq ".." ? "" : $_;push(@path,$part)}if ($ps[-1]eq ".."){push(@path,"")}}else {$pre=":";@ps=@path;@path=();my$part;for (@ps){next if $_ eq ".";$part=$_ eq ".." ? "" : $_;push(@path,$part)}if ($ps[-1]eq ".."){push(@path,"")}}return unless$pre || @path;for (@path){s/;.*//;$_=uri_unescape($_);return if /\0/;return if /:/}$pre .join(":",@path)}sub dir {my$class=shift;my$path=$class->file(@_);return unless defined$path;$path .= ":" unless$path =~ /:$/;$path}1; + package URI::file::Mac;use strict;use warnings;use parent 'URI::file::Base';use URI::Escape qw(uri_unescape);our$VERSION='5.31';sub _file_extract_path {my$class=shift;my$path=shift;my@pre;if ($path =~ s/^(:+)//){if (length($1)==1){@pre=(".")unless length($path)}else {@pre=("..")x (length($1)- 1)}}else {$pre[0]=""}my$isdir=($path =~ s/:$//);$path =~ s,([%/;]), URI::Escape::escape_char($1),eg;my@path=split(/:/,$path,-1);for (@path){if ($_ eq "." || $_ eq ".."){$_="%2E" x length($_)}$_=".." unless length($_)}push (@path,"")if$isdir;(join("/",@pre,@path),1)}sub file {my$class=shift;my$uri=shift;my@path;my$auth=$uri->authority;if (defined$auth){if (lc($auth)ne "localhost" && $auth ne ""){my$u_auth=uri_unescape($auth);if (!$class->_file_is_localhost($u_auth)){@path=("",$auth)}}}my@ps=split("/",$uri->path,-1);shift@ps if@path;push(@path,@ps);my$pre="";if (!@path){return}elsif ($path[0]eq ""){shift(@path);if (@path==1){return if$path[0]eq "";push(@path,"")}@ps=@path;@path=();my$part;for (@ps){next if $_ eq ".";$part=$_ eq ".." ? "" : $_;push(@path,$part)}if ($ps[-1]eq ".."){push(@path,"")}}else {$pre=":";@ps=@path;@path=();my$part;for (@ps){next if $_ eq ".";$part=$_ eq ".." ? "" : $_;push(@path,$part)}if ($ps[-1]eq ".."){push(@path,"")}}return unless$pre || @path;for (@path){s/;.*//;$_=uri_unescape($_);return if /\0/;return if /:/}$pre .join(":",@path)}sub dir {my$class=shift;my$path=$class->file(@_);return unless defined$path;$path .= ":" unless$path =~ /:$/;$path}1; URI_FILE_MAC $fatpacked{"URI/file/OS2.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'URI_FILE_OS2'; - package URI::file::OS2;use strict;use warnings;use parent 'URI::file::Win32';our$VERSION='5.29';sub _file_extract_authority {my$class=shift;return $1 if $_[0]=~ s,^\\\\([^\\]+),,;return $1 if $_[0]=~ s,^//([^/]+),,;if ($_[0]=~ m#^[a-zA-Z]{1,2}:#){return ""}return}sub file {my$p=&URI::file::Win32::file;return unless defined$p;$p =~ s,\\,/,g;$p}1; + package URI::file::OS2;use strict;use warnings;use parent 'URI::file::Win32';our$VERSION='5.31';sub _file_extract_authority {my$class=shift;return $1 if $_[0]=~ s,^\\\\([^\\]+),,;return $1 if $_[0]=~ s,^//([^/]+),,;if ($_[0]=~ m#^[a-zA-Z]{1,2}:#){return ""}return}sub file {my$p=&URI::file::Win32::file;return unless defined$p;$p =~ s,\\,/,g;$p}1; URI_FILE_OS2 $fatpacked{"URI/file/QNX.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'URI_FILE_QNX'; - package URI::file::QNX;use strict;use warnings;use parent 'URI::file::Unix';our$VERSION='5.29';sub _file_extract_path {my($class,$path)=@_;$path =~ s,(.)//+,$1/,g;$path =~ s,(/\.)+/,/,g;$path="./$path" if$path =~ m,^[^:/]+:,,;$path}1; + package URI::file::QNX;use strict;use warnings;use parent 'URI::file::Unix';our$VERSION='5.31';sub _file_extract_path {my($class,$path)=@_;$path =~ s,(.)//+,$1/,g;$path =~ s,(/\.)+/,/,g;$path="./$path" if$path =~ m,^[^:/]+:,,;$path}1; URI_FILE_QNX $fatpacked{"URI/file/Unix.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'URI_FILE_UNIX'; - package URI::file::Unix;use strict;use warnings;use parent 'URI::file::Base';use URI::Escape qw(uri_unescape);our$VERSION='5.29';sub _file_extract_path {my($class,$path)=@_;$path =~ s,//+,/,g;$path =~ s,(/\.)+/,/,g;$path="./$path" if$path =~ m,^[^:/]+:,,;return$path}sub _file_is_absolute {my($class,$path)=@_;return$path =~ m,^/,}sub file {my$class=shift;my$uri=shift;my@path;my$auth=$uri->authority;if (defined($auth)){if (lc($auth)ne "localhost" && $auth ne ""){$auth=uri_unescape($auth);unless ($class->_file_is_localhost($auth)){push(@path,"","",$auth)}}}my@ps=$uri->path_segments;shift@ps if@path;push(@path,@ps);for (@path){return undef if /\0/;return undef if /\//}return join("/",@path)}1; + package URI::file::Unix;use strict;use warnings;use parent 'URI::file::Base';use URI::Escape qw(uri_unescape);our$VERSION='5.31';sub _file_extract_path {my($class,$path)=@_;$path =~ s,//+,/,g;$path =~ s,(/\.)+/,/,g;$path="./$path" if$path =~ m,^[^:/]+:,,;return$path}sub _file_is_absolute {my($class,$path)=@_;return$path =~ m,^/,}sub file {my$class=shift;my$uri=shift;my@path;my$auth=$uri->authority;if (defined($auth)){if (lc($auth)ne "localhost" && $auth ne ""){$auth=uri_unescape($auth);unless ($class->_file_is_localhost($auth)){push(@path,"","",$auth)}}}my@ps=$uri->path_segments;shift@ps if@path;push(@path,@ps);for (@path){return undef if /\0/;return undef if /\//}return join("/",@path)}1; URI_FILE_UNIX $fatpacked{"URI/file/Win32.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'URI_FILE_WIN32'; - package URI::file::Win32;use strict;use warnings;use parent 'URI::file::Base';use URI::Escape qw(uri_unescape);our$VERSION='5.29';sub _file_extract_authority {my$class=shift;return$class->SUPER::_file_extract_authority($_[0])if defined$URI::file::DEFAULT_AUTHORITY;return $1 if $_[0]=~ s,^\\\\([^\\]+),,;return $1 if $_[0]=~ s,^//([^/]+),,;if ($_[0]=~ s,^([a-zA-Z]:),,){my$auth=$1;$auth .= "relative" if $_[0]!~ m,^[\\/],;return$auth}return undef}sub _file_extract_path {my($class,$path)=@_;$path =~ s,\\,/,g;$path =~ s,(/\.)+/,/,g;if (defined$URI::file::DEFAULT_AUTHORITY){$path =~ s,^([a-zA-Z]:),/$1,}return$path}sub _file_is_absolute {my($class,$path)=@_;return$path =~ m,^[a-zA-Z]:, || $path =~ m,^[/\\],}sub file {my$class=shift;my$uri=shift;my$auth=$uri->authority;my$rel;if (defined$auth){$auth=uri_unescape($auth);if ($auth =~ /^([a-zA-Z])[:|](relative)?/){$auth=uc($1).":";$rel++ if $2}elsif (lc($auth)eq "localhost"){$auth=""}elsif (length$auth){$auth="\\\\" .$auth}}else {$auth=""}my@path=$uri->path_segments;for (@path){return undef if /\0/;return undef if /\//}return undef unless$class->fix_path(@path);my$path=join("\\",@path);$path =~ s/^\\// if$rel;$path=$auth .$path;$path =~ s,^\\([a-zA-Z])[:|],\u$1:,;return$path}sub fix_path {1}1; + package URI::file::Win32;use strict;use warnings;use parent 'URI::file::Base';use URI::Escape qw(uri_unescape);our$VERSION='5.31';sub _file_extract_authority {my$class=shift;return$class->SUPER::_file_extract_authority($_[0])if defined$URI::file::DEFAULT_AUTHORITY;return $1 if $_[0]=~ s,^\\\\([^\\]+),,;return $1 if $_[0]=~ s,^//([^/]+),,;if ($_[0]=~ s,^([a-zA-Z]:),,){my$auth=$1;$auth .= "relative" if $_[0]!~ m,^[\\/],;return$auth}return undef}sub _file_extract_path {my($class,$path)=@_;$path =~ s,\\,/,g;$path =~ s,(/\.)+/,/,g;if (defined$URI::file::DEFAULT_AUTHORITY){$path =~ s,^([a-zA-Z]:),/$1,}return$path}sub _file_is_absolute {my($class,$path)=@_;return$path =~ m,^[a-zA-Z]:, || $path =~ m,^[/\\],}sub file {my$class=shift;my$uri=shift;my$auth=$uri->authority;my$rel;if (defined$auth){$auth=uri_unescape($auth);if ($auth =~ /^([a-zA-Z])[:|](relative)?/){$auth=uc($1).":";$rel++ if $2}elsif (lc($auth)eq "localhost"){$auth=""}elsif (length$auth){$auth="\\\\" .$auth}}else {$auth=""}my@path=$uri->path_segments;for (@path){return undef if /\0/;return undef if /\//}return undef unless$class->fix_path(@path);my$path=join("\\",@path);$path =~ s/^\\// if$rel;$path=$auth .$path;$path =~ s,^\\([a-zA-Z])[:|],\u$1:,;return$path}sub fix_path {1}1; URI_FILE_WIN32 $fatpacked{"URI/ftp.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'URI_FTP'; - package URI::ftp;use strict;use warnings;our$VERSION='5.29';use parent qw(URI::_server URI::_userpass);sub default_port {21}sub path {shift->path_query(@_)}sub _user {shift->SUPER::user(@_)}sub _password {shift->SUPER::password(@_)}sub user {my$self=shift;my$user=$self->_user(@_);$user="anonymous" unless defined$user;$user}sub password {my$self=shift;my$pass=$self->_password(@_);unless (defined$pass){my$user=$self->user;if ($user eq 'anonymous' || $user eq 'ftp'){$pass='anonymous@'}}$pass}1; + package URI::ftp;use strict;use warnings;our$VERSION='5.31';use parent qw(URI::_server URI::_userpass);sub default_port {21}sub encrypt_mode {undef}sub path {shift->path_query(@_)}sub _user {shift->SUPER::user(@_)}sub _password {shift->SUPER::password(@_)}sub user {my$self=shift;my$user=$self->_user(@_);$user="anonymous" unless defined$user;$user}sub password {my$self=shift;my$pass=$self->_password(@_);unless (defined$pass){my$user=$self->user;if ($user eq 'anonymous' || $user eq 'ftp'){$pass='anonymous@'}}$pass}1; URI_FTP +$fatpacked{"URI/ftpes.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'URI_FTPES'; + package URI::ftpes;use strict;use warnings;our$VERSION='5.31';use parent 'URI::ftp';sub secure {1}sub encrypt_mode {'explicit'}1; +URI_FTPES + +$fatpacked{"URI/ftps.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'URI_FTPS'; + package URI::ftps;use strict;use warnings;our$VERSION='5.31';use parent 'URI::ftp';sub default_port {990}sub secure {1}sub encrypt_mode {'implicit'}1; +URI_FTPS + $fatpacked{"URI/geo.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'URI_GEO'; - package URI::geo;use warnings;use strict;use Carp;use URI::Split qw(uri_split uri_join);use base qw(URI);our$VERSION='5.29';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}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);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) ) ? + package URI::geo;use warnings;use strict;use Carp;use URI::Split qw(uri_split uri_join);use base qw(URI);our$VERSION='5.31';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}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);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 ) ? @@ -2257,119 +2265,131 @@ $fatpacked{"URI/geo.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'URI_GEO URI_GEO $fatpacked{"URI/gopher.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'URI_GOPHER'; - package URI::gopher;use strict;use warnings;our$VERSION='5.29';use parent 'URI::_server';use URI::Escape qw(uri_unescape);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}sub gtype {goto&gopher_type}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;$path =~ s/\?/\t/;$path=uri_unescape($path);$path =~ s,^/,,;my$gtype=$1 if$path =~ s,^(.),,s;my@path=split(/\t/,$path,3);if (@_){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; + package URI::gopher;use strict;use warnings;our$VERSION='5.31';use parent 'URI::_server';use URI::Escape qw(uri_unescape);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}sub gtype {goto&gopher_type}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;$path =~ s/\?/\t/;$path=uri_unescape($path);$path =~ s,^/,,;my$gtype=$1 if$path =~ s,^(.),,s;my@path=split(/\t/,$path,3);if (@_){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; URI_GOPHER $fatpacked{"URI/http.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'URI_HTTP'; - package URI::http;use strict;use warnings;our$VERSION='5.29';use parent 'URI::_server';sub default_port {80}sub canonical {my$self=shift;my$other=$self->SUPER::canonical;my$slash_path=defined($other->authority)&&!length($other->path)&&!defined($other->query);if ($slash_path){$other=$other->clone if$other==$self;$other->path("/")}$other}1; + package URI::http;use strict;use warnings;our$VERSION='5.31';use parent 'URI::_server';sub default_port {80}sub canonical {my$self=shift;my$other=$self->SUPER::canonical;my$slash_path=defined($other->authority)&&!length($other->path)&&!defined($other->query);if ($slash_path){$other=$other->clone if$other==$self;$other->path("/")}$other}1; URI_HTTP $fatpacked{"URI/https.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'URI_HTTPS'; - package URI::https;use strict;use warnings;our$VERSION='5.29';use parent 'URI::http';sub default_port {443}sub secure {1}1; + package URI::https;use strict;use warnings;our$VERSION='5.31';use parent 'URI::http';sub default_port {443}sub secure {1}1; URI_HTTPS $fatpacked{"URI/icap.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'URI_ICAP'; - package URI::icap;use strict;use warnings;use base qw(URI::http);our$VERSION='5.29';sub default_port {return 1344}1; + package URI::icap;use strict;use warnings;use base qw(URI::http);our$VERSION='5.31';sub default_port {return 1344}1; URI_ICAP $fatpacked{"URI/icaps.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'URI_ICAPS'; - package URI::icaps;use strict;use warnings;use base qw(URI::icap);our$VERSION='5.29';sub secure {return 1}1; + package URI::icaps;use strict;use warnings;use base qw(URI::icap);our$VERSION='5.31';sub secure {return 1}1; URI_ICAPS +$fatpacked{"URI/irc.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'URI_IRC'; + package URI::irc;use strict;use warnings;our$VERSION='5.31';use parent 'URI::_login';use overload ('""'=>sub {$_[0]->as_string},'=='=>sub {URI::_obj_eq(@_)},'!='=>sub {!URI::_obj_eq(@_)},fallback=>1,);sub default_port {6667}sub _init {my$class=shift;my$self=$class->SUPER::_init(@_);$$self =~ s|^((?:[^:/?\#]+:)?(?://[^/?\#]*)?)/\#|$1/%23|s;$self}sub path {my$self=shift;my ($new)=@_;$new =~ s|^/\#|/%23| if (@_ && defined$new);my$val=$self->SUPER::path(@_ ? $new : ());$val =~ s|^/%23|/\#|;$val}sub path_query {my$self=shift;my ($new)=@_;$new =~ s|^/\#|/%23| if (@_ && defined$new);my$val=$self->SUPER::path_query(@_ ? $new : ());$val =~ s|^/%23|/\#|;$val}sub as_string {my$self=shift;my$val=$self->SUPER::as_string;$val =~ s|^((?:[^:/?\#]+:)?(?://[^/?\#]*)?)/%23|$1/\#|s;$val}sub entity {my$self=shift;my$path=$self->path;$path =~ s|^/||;my ($entity,@flags)=split /,/,$path;if (@_){my$new=shift;$new='' unless defined$new;$self->path('/'.join(',',$new,@flags))}return unless length$entity;$entity}sub flags {my$self=shift;my$path=$self->path;$path =~ s|^/||;my ($entity,@flags)=split /,/,$path;if (@_){$self->path('/'.join(',',$entity,@_))}@flags}sub options {shift->query_form(@_)}sub canonical {my$self=shift;my$other=$self->SUPER::canonical;my$path=$other->path;$path =~ s|^/||;my ($entity,@flags)=split /,/,$path;my@clean=map {$_ eq 'isnick' ? 'isuser' : $_}map {lc}grep {/^(?:is(?:user|channel|server|network|nick)|need(?:pass|key))$/i}@flags ;my ($enttype)=grep {/^is(?:user|channel)$/}@clean;my ($hosttype)=grep {/^is(?:server|network)$/}@clean;my@others=grep {/^need(?:pass|key)$/}@clean;my@new=($enttype ? $enttype : (),$hosttype ? $hosttype : (),@others,);unless (join(',',@new)eq join(',',@flags)){$other=$other->clone if$other==$self;$other->path('/'.join(',',$entity,@new))}$other}1; +URI_IRC + +$fatpacked{"URI/ircs.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'URI_IRCS'; + package URI::ircs;use strict;use warnings;our$VERSION='5.31';use parent 'URI::irc';sub default_port {994}sub secure {1}1; +URI_IRCS + $fatpacked{"URI/ldap.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'URI_LDAP'; - package URI::ldap;use strict;use warnings;our$VERSION='5.29';use parent qw(URI::_ldap URI::_server);sub default_port {389}sub _nonldap_canonical {my$self=shift;$self->URI::_server::canonical(@_)}1; + package URI::ldap;use strict;use warnings;our$VERSION='5.31';use parent qw(URI::_ldap URI::_server);sub default_port {389}sub _nonldap_canonical {my$self=shift;$self->URI::_server::canonical(@_)}1; URI_LDAP $fatpacked{"URI/ldapi.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'URI_LDAPI'; - package URI::ldapi;use strict;use warnings;our$VERSION='5.29';use parent qw(URI::_ldap URI::_generic);use URI::Escape ();sub un_path {my$self=shift;my$old=URI::Escape::uri_unescape($self->authority);if (@_){my$p=shift;$p =~ s/:/%3A/g;$p =~ s/\@/%40/g;$self->authority($p)}return$old}sub _nonldap_canonical {my$self=shift;$self->URI::_generic::canonical(@_)}1; + package URI::ldapi;use strict;use warnings;our$VERSION='5.31';use parent qw(URI::_ldap URI::_generic);use URI::Escape ();sub un_path {my$self=shift;my$old=URI::Escape::uri_unescape($self->authority);if (@_){my$p=shift;$p =~ s/:/%3A/g;$p =~ s/\@/%40/g;$self->authority($p)}return$old}sub _nonldap_canonical {my$self=shift;$self->URI::_generic::canonical(@_)}1; URI_LDAPI $fatpacked{"URI/ldaps.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'URI_LDAPS'; - package URI::ldaps;use strict;use warnings;our$VERSION='5.29';use parent 'URI::ldap';sub default_port {636}sub secure {1}1; + package URI::ldaps;use strict;use warnings;our$VERSION='5.31';use parent 'URI::ldap';sub default_port {636}sub secure {1}1; URI_LDAPS $fatpacked{"URI/mailto.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'URI_MAILTO'; - package URI::mailto;use strict;use warnings;our$VERSION='5.29';use parent qw(URI URI::_query);sub to {my$self=shift;my@old=$self->headers;if (@_){my@new=@old;for (my$i=0;$i < @new;$i += 2){if (lc($new[$i]|| '')eq "to"){splice(@new,$i,2);redo}}my$to=shift;$to="" unless defined$to;unshift(@new,"to"=>$to);$self->headers(@new)}return unless defined wantarray;my@to;while (@old){my$h=shift@old;my$v=shift@old;push(@to,$v)if lc($h)eq "to"}join(",",@to)}sub headers {my$self=shift;my$opaque="to=" .$self->opaque;$opaque =~ s/\?/&/;if (@_){my@new=@_;my@to;for (my$i=0;$i < @new;$i += 2){if (lc($new[$i]|| '')eq "to"){push(@to,(splice(@new,$i,2))[1]);redo}}my$new=join(",",@to);$new =~ s/%/%25/g;$new =~ s/\?/%3F/g;$self->opaque($new);$self->query_form(@new)if@new}return unless defined wantarray;URI->new("mailto:?$opaque")->query_form}sub query_form {my$self=shift;my@fields=$self->SUPER::query_form(@_);for (my$i=0 ;$i < @fields ;$i += 2 ){if ($fields[0]eq 'to'){$fields[1]=~ s/ /+/g;last}}return@fields}1; + package URI::mailto;use strict;use warnings;our$VERSION='5.31';use parent qw(URI URI::_query);sub to {my$self=shift;my@old=$self->headers;if (@_){my@new=@old;for (my$i=0;$i < @new;$i += 2){if (lc($new[$i]|| '')eq "to"){splice(@new,$i,2);redo}}my$to=shift;$to="" unless defined$to;unshift(@new,"to"=>$to);$self->headers(@new)}return unless defined wantarray;my@to;while (@old){my$h=shift@old;my$v=shift@old;push(@to,$v)if lc($h)eq "to"}join(",",@to)}sub headers {my$self=shift;my$opaque="to=" .$self->opaque;$opaque =~ s/\?/&/;if (@_){my@new=@_;my@to;for (my$i=0;$i < @new;$i += 2){if (lc($new[$i]|| '')eq "to"){push(@to,(splice(@new,$i,2))[1]);redo}}my$new=join(",",@to);$new =~ s/%/%25/g;$new =~ s/\?/%3F/g;$self->opaque($new);$self->query_form(@new)if@new}return unless defined wantarray;URI->new("mailto:?$opaque")->query_form}sub query_form {my$self=shift;my@fields=$self->SUPER::query_form(@_);for (my$i=0 ;$i < @fields ;$i += 2 ){if ($fields[0]eq 'to'){$fields[1]=~ s/ /+/g;last}}return@fields}1; URI_MAILTO $fatpacked{"URI/mms.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'URI_MMS'; - package URI::mms;use strict;use warnings;our$VERSION='5.29';use parent 'URI::http';sub default_port {1755}1; + package URI::mms;use strict;use warnings;our$VERSION='5.31';use parent 'URI::http';sub default_port {1755}1; URI_MMS $fatpacked{"URI/news.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'URI_NEWS'; - package URI::news;use strict;use warnings;our$VERSION='5.29';use parent 'URI::_server';use URI::Escape qw(uri_unescape);use Carp ();sub default_port {119}sub _group {my$self=shift;my$old=$self->path;if (@_){my($group,$from,$to)=@_;if ($group =~ /\@/){$group =~ s/^<(.*)>$/$1/}$group =~ s,%,%25,g;$group =~ s,/,%2F,g;my$path=$group;if (defined$from){$path .= "/$from";$path .= "-$to" if defined$to}$self->path($path)}$old =~ s,^/,,;if ($old !~ /\@/ && $old =~ s,/(.*),, && wantarray){my$extra=$1;return (uri_unescape($old),split(/-/,$extra))}uri_unescape($old)}sub group {my$self=shift;if (@_){Carp::croak("Group name can't contain '\@'")if $_[0]=~ /\@/}my@old=$self->_group(@_);return if$old[0]=~ /\@/;wantarray ? @old : $old[0]}sub message {my$self=shift;if (@_){Carp::croak("Message must contain '\@'")unless $_[0]=~ /\@/}my$old=$self->_group(@_);return undef unless$old =~ /\@/;return$old}1; + package URI::news;use strict;use warnings;our$VERSION='5.31';use parent 'URI::_server';use URI::Escape qw(uri_unescape);use Carp ();sub default_port {119}sub _group {my$self=shift;my$old=$self->path;if (@_){my($group,$from,$to)=@_;if ($group =~ /\@/){$group =~ s/^<(.*)>$/$1/}$group =~ s,%,%25,g;$group =~ s,/,%2F,g;my$path=$group;if (defined$from){$path .= "/$from";$path .= "-$to" if defined$to}$self->path($path)}$old =~ s,^/,,;if ($old !~ /\@/ && $old =~ s,/(.*),, && wantarray){my$extra=$1;return (uri_unescape($old),split(/-/,$extra))}uri_unescape($old)}sub group {my$self=shift;if (@_){Carp::croak("Group name can't contain '\@'")if $_[0]=~ /\@/}my@old=$self->_group(@_);return if$old[0]=~ /\@/;wantarray ? @old : $old[0]}sub message {my$self=shift;if (@_){Carp::croak("Message must contain '\@'")unless $_[0]=~ /\@/}my$old=$self->_group(@_);return undef unless$old =~ /\@/;return$old}1; URI_NEWS $fatpacked{"URI/nntp.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'URI_NNTP'; - package URI::nntp;use strict;use warnings;our$VERSION='5.29';use parent 'URI::news';1; + package URI::nntp;use strict;use warnings;our$VERSION='5.31';use parent 'URI::news';1; URI_NNTP $fatpacked{"URI/nntps.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'URI_NNTPS'; - package URI::nntps;use strict;use warnings;our$VERSION='5.29';use parent 'URI::nntp';sub default_port {563}sub secure {1}1; + package URI::nntps;use strict;use warnings;our$VERSION='5.31';use parent 'URI::nntp';sub default_port {563}sub secure {1}1; URI_NNTPS $fatpacked{"URI/otpauth.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'URI_OTPAUTH'; - package URI::otpauth;use warnings;use strict;use MIME::Base32();use URI::Split();use URI::Escape();use parent qw(URI URI::_query);our$VERSION='5.29';sub new {my ($class,@parameters)=@_;my%fields=$class->_set(@parameters);my$uri=URI::Split::uri_join('otpauth',$fields{type},$class->_path(%fields),$class->_query(%fields),);return bless \$uri,$class}sub _parse {my$self=shift;my ($scheme,$type,$path,$query,$frag)=URI::Split::uri_split(${$self});$path =~ s/^\///smxg;my@path_parts=split /:/smx,$path;my ($issuer_prefix,$account_name);if (scalar@path_parts==1){$account_name=$path_parts[0]}else {$issuer_prefix=$path_parts[0];$account_name=$path_parts[1]}my%fields=(label=>$path,type=>$type,account_name=>$account_name);my$issuer_parameter=$self->query_param('issuer');if (defined$issuer_parameter){if ((defined$issuer_prefix)&& ($issuer_prefix ne $issuer_parameter)){Carp::carp("Issuer prefix from label '$issuer_prefix' does not match issuer parameter '$issuer_parameter'")}$fields{issuer}=$issuer_parameter}elsif (defined$issuer_prefix){$fields{issuer}=URI::Escape::uri_unescape($issuer_prefix)}if (my$encoded_secret=$self->query_param('secret')){$fields{secret}=MIME::Base32::decode_base32($encoded_secret)}for my$name (qw(algorithm digits counter period)){if (my$value=$self->query_param($name)){$fields{$name}=$value}}%fields=$self->_set(%fields);return ($scheme,$fields{type},\%fields,$query,$frag)}my$label_escape_regex=qr/[^[:alnum:]@.]/smx;sub _set {my ($self,%fields)=@_;delete$fields{label};if (defined$fields{account_name}){if (defined$fields{issuer}){$fields{label}=$fields{issuer}.q[:] .$fields{account_name}}else {$fields{label}=$fields{account_name}}}if (!length$fields{type}){$fields{type}='totp'}return%fields}my%field_names=map {$_=>1}qw(secret label counter algorithm period digits issuer type account_name);my@query_names=qw(secret issuer algorithm digits counter period);my%defaults=(algorithm=>'SHA1',digits=>6,type=>'totp',period=>30);sub _field {my ($self,$name,@remainder)=@_;my ($scheme,$type,$fields,$query,$frag)=$self->_parse();if (!@remainder){if (defined$fields->{$name}){return$fields->{$name}}else {return$defaults{$name}}}$fields->{$name}=shift@remainder;${$self}=URI::Split::uri_join($scheme,$fields->{type},$self->_path(%{$fields}),$self->_query(%{$fields}),$frag);return$self}sub _query {my ($class,%fields)=@_;if (defined$fields{secret}){$fields{secret}=MIME::Base32::encode_base32($fields{secret})}else {Carp::croak('secret is a mandatory parameter for ' .__PACKAGE__)}return join q[&],map {join q[=],$_=>$fields{$_}}grep {exists$fields{$_}}@query_names}sub _path {my ($class,%fields)=@_;my$path=$fields{label};return$path}sub type {my ($self,@parameters)=@_;return$self->_field('type',@parameters)}sub label {my ($self,@parameters)=@_;return$self->_field('label',@parameters)}sub account_name {my ($self,@parameters)=@_;return$self->_field('account_name',@parameters)}sub issuer {my ($self,@parameters)=@_;return$self->_field('issuer',@parameters)}sub secret {my ($self,@parameters)=@_;return$self->_field('secret',@parameters)}sub algorithm {my ($self,@parameters)=@_;return$self->_field('algorithm',@parameters)}sub counter {my ($self,@parameters)=@_;return$self->_field('counter',@parameters)}sub digits {my ($self,@parameters)=@_;return$self->_field('digits',@parameters)}sub period {my ($self,@parameters)=@_;return$self->_field('period',@parameters)}1; + package URI::otpauth;use warnings;use strict;use MIME::Base32();use URI::Split();use URI::Escape();use parent qw(URI URI::_query);our$VERSION='5.31';sub new {my ($class,@parameters)=@_;my%fields=$class->_set(@parameters);my$uri=URI::Split::uri_join('otpauth',$fields{type},$class->_path(%fields),$class->_query(%fields),);return bless \$uri,$class}sub _parse {my$self=shift;my ($scheme,$type,$path,$query,$frag)=URI::Split::uri_split(${$self});$path =~ s/^\///smxg;my@path_parts=split /:/smx,$path;my ($issuer_prefix,$account_name);if (scalar@path_parts==1){$account_name=$path_parts[0]}else {$issuer_prefix=$path_parts[0];$account_name=$path_parts[1]}my%fields=(label=>$path,type=>$type,account_name=>$account_name);my$issuer_parameter=$self->query_param('issuer');if (defined$issuer_parameter){if ((defined$issuer_prefix)&& ($issuer_prefix ne $issuer_parameter)){Carp::carp("Issuer prefix from label '$issuer_prefix' does not match issuer parameter '$issuer_parameter'")}$fields{issuer}=$issuer_parameter}elsif (defined$issuer_prefix){$fields{issuer}=URI::Escape::uri_unescape($issuer_prefix)}if (my$encoded_secret=$self->query_param('secret')){$fields{secret}=MIME::Base32::decode_base32($encoded_secret)}for my$name (qw(algorithm digits counter period)){if (my$value=$self->query_param($name)){$fields{$name}=$value}}%fields=$self->_set(%fields);return ($scheme,$fields{type},\%fields,$query,$frag)}my$label_escape_regex=qr/[^[:alnum:]@.]/smx;sub _set {my ($self,%fields)=@_;delete$fields{label};if (defined$fields{account_name}){if (defined$fields{issuer}){$fields{label}=$fields{issuer}.q[:] .$fields{account_name}}else {$fields{label}=$fields{account_name}}}if (!length$fields{type}){$fields{type}='totp'}return%fields}my%field_names=map {$_=>1}qw(secret label counter algorithm period digits issuer type account_name);my@query_names=qw(secret issuer algorithm digits counter period);my%defaults=(algorithm=>'SHA1',digits=>6,type=>'totp',period=>30);sub _field {my ($self,$name,@remainder)=@_;my ($scheme,$type,$fields,$query,$frag)=$self->_parse();if (!@remainder){if (defined$fields->{$name}){return$fields->{$name}}else {return$defaults{$name}}}$fields->{$name}=shift@remainder;${$self}=URI::Split::uri_join($scheme,$fields->{type},$self->_path(%{$fields}),$self->_query(%{$fields}),$frag);return$self}sub _query {my ($class,%fields)=@_;if (defined$fields{secret}){$fields{secret}=MIME::Base32::encode_base32($fields{secret})}else {Carp::croak('secret is a mandatory parameter for ' .__PACKAGE__)}return join q[&],map {join q[=],$_=>$fields{$_}}grep {exists$fields{$_}}@query_names}sub _path {my ($class,%fields)=@_;my$path=$fields{label};return$path}sub type {my ($self,@parameters)=@_;return$self->_field('type',@parameters)}sub label {my ($self,@parameters)=@_;return$self->_field('label',@parameters)}sub account_name {my ($self,@parameters)=@_;return$self->_field('account_name',@parameters)}sub issuer {my ($self,@parameters)=@_;return$self->_field('issuer',@parameters)}sub secret {my ($self,@parameters)=@_;return$self->_field('secret',@parameters)}sub algorithm {my ($self,@parameters)=@_;return$self->_field('algorithm',@parameters)}sub counter {my ($self,@parameters)=@_;return$self->_field('counter',@parameters)}sub digits {my ($self,@parameters)=@_;return$self->_field('digits',@parameters)}sub period {my ($self,@parameters)=@_;return$self->_field('period',@parameters)}1; URI_OTPAUTH $fatpacked{"URI/pop.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'URI_POP'; - package URI::pop;use strict;use warnings;our$VERSION='5.29';use parent 'URI::_server';use URI::Escape qw(uri_unescape);sub default_port {110}sub user {my$self=shift;my$old=$self->userinfo;if (@_){my$new_info=$old;$new_info="" unless defined$new_info;$new_info =~ s/^[^;]*//;my$new=shift;if (!defined($new)&&!length($new_info)){$self->userinfo(undef)}else {$new="" unless defined$new;$new =~ s/%/%25/g;$new =~ s/;/%3B/g;$self->userinfo("$new$new_info")}}return undef unless defined$old;$old =~ s/;.*//;return uri_unescape($old)}sub auth {my$self=shift;my$old=$self->userinfo;if (@_){my$new=$old;$new="" unless defined$new;$new =~ s/(^[^;]*)//;my$user=$1;$new =~ s/;auth=[^;]*//i;my$auth=shift;if (defined$auth){$auth =~ s/%/%25/g;$auth =~ s/;/%3B/g;$new=";AUTH=$auth$new"}$self->userinfo("$user$new")}return undef unless defined$old;$old =~ s/^[^;]*//;return uri_unescape($1)if$old =~ /;auth=(.*)/i;return}1; + package URI::pop;use strict;use warnings;our$VERSION='5.31';use parent 'URI::_server';use URI::Escape qw(uri_unescape);sub default_port {110}sub user {my$self=shift;my$old=$self->userinfo;if (@_){my$new_info=$old;$new_info="" unless defined$new_info;$new_info =~ s/^[^;]*//;my$new=shift;if (!defined($new)&&!length($new_info)){$self->userinfo(undef)}else {$new="" unless defined$new;$new =~ s/%/%25/g;$new =~ s/;/%3B/g;$self->userinfo("$new$new_info")}}return undef unless defined$old;$old =~ s/;.*//;return uri_unescape($old)}sub auth {my$self=shift;my$old=$self->userinfo;if (@_){my$new=$old;$new="" unless defined$new;$new =~ s/(^[^;]*)//;my$user=$1;$new =~ s/;auth=[^;]*//i;my$auth=shift;if (defined$auth){$auth =~ s/%/%25/g;$auth =~ s/;/%3B/g;$new=";AUTH=$auth$new"}$self->userinfo("$user$new")}return undef unless defined$old;$old =~ s/^[^;]*//;return uri_unescape($1)if$old =~ /;auth=(.*)/i;return}1; URI_POP $fatpacked{"URI/rlogin.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'URI_RLOGIN'; - package URI::rlogin;use strict;use warnings;our$VERSION='5.29';use parent 'URI::_login';sub default_port {513}1; + package URI::rlogin;use strict;use warnings;our$VERSION='5.31';use parent 'URI::_login';sub default_port {513}1; URI_RLOGIN $fatpacked{"URI/rsync.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'URI_RSYNC'; - package URI::rsync;use strict;use warnings;our$VERSION='5.29';use parent qw(URI::_server URI::_userpass);sub default_port {873}1; + package URI::rsync;use strict;use warnings;our$VERSION='5.31';use parent qw(URI::_server URI::_userpass);sub default_port {873}1; URI_RSYNC $fatpacked{"URI/rtsp.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'URI_RTSP'; - package URI::rtsp;use strict;use warnings;our$VERSION='5.29';use parent 'URI::http';sub default_port {554}1; + package URI::rtsp;use strict;use warnings;our$VERSION='5.31';use parent 'URI::http';sub default_port {554}1; URI_RTSP $fatpacked{"URI/rtspu.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'URI_RTSPU'; - package URI::rtspu;use strict;use warnings;our$VERSION='5.29';use parent 'URI::rtsp';sub default_port {554}1; + package URI::rtspu;use strict;use warnings;our$VERSION='5.31';use parent 'URI::rtsp';sub default_port {554}1; URI_RTSPU +$fatpacked{"URI/scp.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'URI_SCP'; + package URI::scp;use strict;use warnings;our$VERSION='5.31';use parent 'URI::ssh';1; +URI_SCP + $fatpacked{"URI/sftp.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'URI_SFTP'; - package URI::sftp;use strict;use warnings;use parent 'URI::ssh';our$VERSION='5.29';1; + package URI::sftp;use strict;use warnings;our$VERSION='5.31';use parent 'URI::ssh';1; URI_SFTP $fatpacked{"URI/sip.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'URI_SIP'; - package URI::sip;use strict;use warnings;use parent qw(URI::_server URI::_userpass);use URI::Escape ();our$VERSION='5.29';sub default_port {5060}sub authority {my$self=shift;$$self =~ m,^($URI::scheme_re:)?([^;?]*)(.*)$,os or die;my$start=$1;my$authoritystr=$2;my$rest=$3;if (@_){$authoritystr=shift;$authoritystr =~ s/([^$URI::uric])/ URI::Escape::escape_char($1)/ego;$$self=$start .$authoritystr .$rest}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@paramarr;for (my$i=0;$i < @_;$i += 2){push(@paramarr,"$_[$i]=$_[$i+1]")}$paramstr=join(";",@paramarr);$$self=$start .";" .$paramstr .$rest}$paramstr =~ s/^;//o;return split(/[;=]/,$paramstr)}sub params {my$self=shift;$$self =~ m,^((?:$URI::scheme_re:)?)(?:([^;?]*))?(;[^?]*)?(.*)$,os or die;my$start=$1 .$2;my$paramstr=$3;my$rest=$4;if (@_){$paramstr=shift;$$self=$start .";" .$paramstr .$rest}$paramstr =~ s/^;//o;return$paramstr}sub path {}sub path_query {}sub path_segments {}sub abs {shift}sub rel {shift}sub query_keywords {}1; + package URI::sip;use strict;use warnings;use parent qw(URI::_server URI::_userpass);use URI::Escape ();our$VERSION='5.31';sub default_port {5060}sub authority {my$self=shift;$$self =~ m,^($URI::scheme_re:)?([^;?]*)(.*)$,os or die;my$start=$1;my$authoritystr=$2;my$rest=$3;if (@_){$authoritystr=shift;$authoritystr =~ s/([^$URI::uric])/ URI::Escape::escape_char($1)/ego;$$self=$start .$authoritystr .$rest}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@paramarr;for (my$i=0;$i < @_;$i += 2){push(@paramarr,"$_[$i]=$_[$i+1]")}$paramstr=join(";",@paramarr);$$self=$start .";" .$paramstr .$rest}$paramstr =~ s/^;//o;return split(/[;=]/,$paramstr)}sub params {my$self=shift;$$self =~ m,^((?:$URI::scheme_re:)?)(?:([^;?]*))?(;[^?]*)?(.*)$,os or die;my$start=$1 .$2;my$paramstr=$3;my$rest=$4;if (@_){$paramstr=shift;$$self=$start .";" .$paramstr .$rest}$paramstr =~ s/^;//o;return$paramstr}sub path {}sub path_query {}sub path_segments {}sub abs {shift}sub rel {shift}sub query_keywords {}1; URI_SIP $fatpacked{"URI/sips.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'URI_SIPS'; - package URI::sips;use strict;use warnings;our$VERSION='5.29';use parent 'URI::sip';sub default_port {5061}sub secure {1}1; + package URI::sips;use strict;use warnings;our$VERSION='5.31';use parent 'URI::sip';sub default_port {5061}sub secure {1}1; URI_SIPS $fatpacked{"URI/snews.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'URI_SNEWS'; - package URI::snews;use strict;use warnings;our$VERSION='5.29';use parent 'URI::news';sub default_port {563}sub secure {1}1; + package URI::snews;use strict;use warnings;our$VERSION='5.31';use parent 'URI::news';sub default_port {563}sub secure {1}1; URI_SNEWS $fatpacked{"URI/ssh.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'URI_SSH'; - package URI::ssh;use strict;use warnings;our$VERSION='5.29';use parent 'URI::_login';sub default_port {22}sub secure {1}1; + package URI::ssh;use strict;use warnings;our$VERSION='5.31';use parent 'URI::_login';sub default_port {22}sub secure {1}1; URI_SSH $fatpacked{"URI/telnet.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'URI_TELNET'; - package URI::telnet;use strict;use warnings;our$VERSION='5.29';use parent 'URI::_login';sub default_port {23}1; + package URI::telnet;use strict;use warnings;our$VERSION='5.31';use parent 'URI::_login';sub default_port {23}1; URI_TELNET $fatpacked{"URI/tn3270.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'URI_TN3270'; - package URI::tn3270;use strict;use warnings;our$VERSION='5.29';use parent 'URI::_login';sub default_port {23}1; + package URI::tn3270;use strict;use warnings;our$VERSION='5.31';use parent 'URI::_login';sub default_port {23}1; URI_TN3270 $fatpacked{"URI/urn.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'URI_URN'; - package URI::urn;use strict;use warnings;our$VERSION='5.29';use parent 'URI';use Carp qw(carp);my%implementor;sub _init {my$class=shift;my$self=$class->SUPER::_init(@_);my$nid=$self->nid;my$impclass=$implementor{$nid};return$impclass->_urn_init($self,$nid)if$impclass;$impclass="URI::urn";if ($nid =~ /^[A-Za-z\d][A-Za-z\d\-]*\z/){my$id=$nid;$id =~ s/-/_/g;$id="_$id" if$id =~ /^\d/;$impclass="URI::urn::$id";no strict 'refs';unless (@{"${impclass}::ISA"}){my$_old_error=$@;eval "require $impclass";die $@ if $@ && $@ !~ /Can\'t locate.*in \@INC/;$@=$_old_error;$impclass="URI::urn" unless @{"${impclass}::ISA"}}}else {carp("Illegal namespace identifier '$nid' for URN '$self'")if $^W}$implementor{$nid}=$impclass;return$impclass->_urn_init($self,$nid)}sub _urn_init {my($class,$self,$nid)=@_;bless$self,$class}sub _nid {my$self=shift;my$opaque=$self->opaque;if (@_){my$v=$opaque;my$new=shift;$v =~ s/[^:]*/$new/;$self->opaque($v)}$opaque =~ s/:.*//s;return$opaque}sub nid {my$self=shift;my$nid=$self->_nid(@_);$nid=lc($nid)if defined($nid);return$nid}sub nss {my$self=shift;my$opaque=$self->opaque;if (@_){my$v=$opaque;my$new=shift;if (defined$new){$v =~ s/(:|\z).*/:$new/}else {$v =~ s/:.*//s}$self->opaque($v)}return undef unless$opaque =~ s/^[^:]*://;return$opaque}sub canonical {my$self=shift;my$nid=$self->_nid;my$new=$self->SUPER::canonical;return$new if$nid !~ /[A-Z]/ || $nid =~ /%/;$new=$new->clone if$new==$self;$new->nid(lc($nid));return$new}1; + package URI::urn;use strict;use warnings;our$VERSION='5.31';use parent 'URI';use Carp qw(carp);my%implementor;sub _init {my$class=shift;my$self=$class->SUPER::_init(@_);my$nid=$self->nid;my$impclass=$implementor{$nid};return$impclass->_urn_init($self,$nid)if$impclass;$impclass="URI::urn";if ($nid =~ /^[A-Za-z\d][A-Za-z\d\-]*\z/){my$id=$nid;$id =~ s/-/_/g;$id="_$id" if$id =~ /^\d/;$impclass="URI::urn::$id";no strict 'refs';unless (@{"${impclass}::ISA"}){my$_old_error=$@;eval "require $impclass";die $@ if $@ && $@ !~ /Can\'t locate.*in \@INC/;$@=$_old_error;$impclass="URI::urn" unless @{"${impclass}::ISA"}}}else {carp("Illegal namespace identifier '$nid' for URN '$self'")if $^W}$implementor{$nid}=$impclass;return$impclass->_urn_init($self,$nid)}sub _urn_init {my($class,$self,$nid)=@_;bless$self,$class}sub _nid {my$self=shift;my$opaque=$self->opaque;if (@_){my$v=$opaque;my$new=shift;$v =~ s/[^:]*/$new/;$self->opaque($v)}$opaque =~ s/:.*//s;return$opaque}sub nid {my$self=shift;my$nid=$self->_nid(@_);$nid=lc($nid)if defined($nid);return$nid}sub nss {my$self=shift;my$opaque=$self->opaque;if (@_){my$v=$opaque;my$new=shift;if (defined$new){$v =~ s/(:|\z).*/:$new/}else {$v =~ s/:.*//s}$self->opaque($v)}return undef unless$opaque =~ s/^[^:]*://;return$opaque}sub canonical {my$self=shift;my$nid=$self->_nid;my$new=$self->SUPER::canonical;return$new if$nid !~ /[A-Z]/ || $nid =~ /%/;$new=$new->clone if$new==$self;$new->nid(lc($nid));return$new}1; URI_URN $fatpacked{"URI/urn/isbn.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'URI_URN_ISBN'; - package URI::urn::isbn;use strict;use warnings;our$VERSION='5.29';use parent 'URI::urn';use Carp qw(carp);BEGIN {require Business::ISBN;local $^W=0;warn "Using Business::ISBN version " .Business::ISBN->VERSION ." which is deprecated.\nUpgrade to Business::ISBN version 3.005\n" if Business::ISBN->VERSION < 3.005}sub _isbn {my$nss=shift;$nss=$nss->nss if ref($nss);my$isbn=Business::ISBN->new($nss);$isbn=undef if$isbn &&!$isbn->is_valid;return$isbn}sub _nss_isbn {my$self=shift;my$nss=$self->nss(@_);my$isbn=_isbn($nss);$isbn=$isbn->as_string if$isbn;return($nss,$isbn)}sub isbn {my$self=shift;my$isbn;(undef,$isbn)=$self->_nss_isbn(@_);return$isbn}sub isbn_publisher_code {my$isbn=shift->_isbn || return undef;return$isbn->publisher_code}BEGIN {my$group_method=do {local $^W=0;Business::ISBN->VERSION >= 2 ? 'group_code' : 'country_code'};sub isbn_group_code {my$isbn=shift->_isbn || return undef;return$isbn->$group_method}}sub isbn_country_code {my$name=(caller(0))[3];$name =~ s/.*:://;carp "$name is DEPRECATED. Use isbn_group_code instead";no strict 'refs';&isbn_group_code}BEGIN {my$isbn13_method=do {local $^W=0;Business::ISBN->VERSION >= 2 ? 'as_isbn13' : 'as_ean'};sub isbn13 {my$isbn=shift->_isbn || return undef;my$thingy=$isbn->$isbn13_method;return eval {$thingy->can('as_string')}? $thingy->as_string([]): $thingy}}sub isbn_as_ean {my$name=(caller(0))[3];$name =~ s/.*:://;carp "$name is DEPRECATED. Use isbn13 instead";no strict 'refs';&isbn13}sub canonical {my$self=shift;my($nss,$isbn)=$self->_nss_isbn;my$new=$self->SUPER::canonical;return$new unless$nss && $isbn && $nss ne $isbn;$new=$new->clone if$new==$self;$new->nss($isbn);return$new}1; + package URI::urn::isbn;use strict;use warnings;our$VERSION='5.31';use parent 'URI::urn';use Carp qw(carp);BEGIN {require Business::ISBN;local $^W=0;warn "Using Business::ISBN version " .Business::ISBN->VERSION ." which is deprecated.\nUpgrade to Business::ISBN version 3.005\n" if Business::ISBN->VERSION < 3.005}sub _isbn {my$nss=shift;$nss=$nss->nss if ref($nss);my$isbn=Business::ISBN->new($nss);$isbn=undef if$isbn &&!$isbn->is_valid;return$isbn}sub _nss_isbn {my$self=shift;my$nss=$self->nss(@_);my$isbn=_isbn($nss);$isbn=$isbn->as_string if$isbn;return($nss,$isbn)}sub isbn {my$self=shift;my$isbn;(undef,$isbn)=$self->_nss_isbn(@_);return$isbn}sub isbn_publisher_code {my$isbn=shift->_isbn || return undef;return$isbn->publisher_code}BEGIN {my$group_method=do {local $^W=0;Business::ISBN->VERSION >= 2 ? 'group_code' : 'country_code'};sub isbn_group_code {my$isbn=shift->_isbn || return undef;return$isbn->$group_method}}sub isbn_country_code {my$name=(caller(0))[3];$name =~ s/.*:://;carp "$name is DEPRECATED. Use isbn_group_code instead";no strict 'refs';&isbn_group_code}BEGIN {my$isbn13_method=do {local $^W=0;Business::ISBN->VERSION >= 2 ? 'as_isbn13' : 'as_ean'};sub isbn13 {my$isbn=shift->_isbn || return undef;my$thingy=$isbn->$isbn13_method;return eval {$thingy->can('as_string')}? $thingy->as_string([]): $thingy}}sub isbn_as_ean {my$name=(caller(0))[3];$name =~ s/.*:://;carp "$name is DEPRECATED. Use isbn13 instead";no strict 'refs';&isbn13}sub canonical {my$self=shift;my($nss,$isbn)=$self->_nss_isbn;my$new=$self->SUPER::canonical;return$new unless$nss && $isbn && $nss ne $isbn;$new=$new->clone if$new==$self;$new->nss($isbn);return$new}1; URI_URN_ISBN $fatpacked{"URI/urn/oid.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'URI_URN_OID'; - package URI::urn::oid;use strict;use warnings;our$VERSION='5.29';use parent 'URI::urn';sub oid {my$self=shift;my$old=$self->nss;if (@_){$self->nss(join(".",@_))}return split(/\./,$old)if wantarray;return$old}1; + package URI::urn::oid;use strict;use warnings;our$VERSION='5.31';use parent 'URI::urn';sub oid {my$self=shift;my$old=$self->nss;if (@_){$self->nss(join(".",@_))}return split(/\./,$old)if wantarray;return$old}1; URI_URN_OID $fatpacked{"Win32/ShellQuote.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'WIN32_SHELLQUOTE';