summaryrefslogtreecommitdiff
path: root/Master/tlpkg/tlperl/lib/URI.pm
diff options
context:
space:
mode:
Diffstat (limited to 'Master/tlpkg/tlperl/lib/URI.pm')
-rw-r--r--Master/tlpkg/tlperl/lib/URI.pm48
1 files changed, 33 insertions, 15 deletions
diff --git a/Master/tlpkg/tlperl/lib/URI.pm b/Master/tlpkg/tlperl/lib/URI.pm
index eb1970eab99..de118e7e2fb 100644
--- a/Master/tlpkg/tlperl/lib/URI.pm
+++ b/Master/tlpkg/tlperl/lib/URI.pm
@@ -1,22 +1,22 @@
package URI;
use strict;
-use vars qw($VERSION);
-$VERSION = "1.60";
+use warnings;
-use vars qw($ABS_REMOTE_LEADING_DOTS $ABS_ALLOW_RELATIVE_SCHEME $DEFAULT_QUERY_FORM_DELIMITER);
+our $VERSION = "1.67";
+
+our ($ABS_REMOTE_LEADING_DOTS, $ABS_ALLOW_RELATIVE_SCHEME, $DEFAULT_QUERY_FORM_DELIMITER);
my %implements; # mapping from scheme to implementor class
# Some "official" character classes
-use vars qw($reserved $mark $unreserved $uric $scheme_re);
-$reserved = q(;/?:@&=+$,[]);
-$mark = q(-_.!~*'()); #'; emacs
-$unreserved = "A-Za-z0-9\Q$mark\E";
-$uric = quotemeta($reserved) . $unreserved . "%";
+our $reserved = q(;/?:@&=+$,[]);
+our $mark = q(-_.!~*'()); #'; emacs
+our $unreserved = "A-Za-z0-9\Q$mark\E";
+our $uric = quotemeta($reserved) . $unreserved . "%";
-$scheme_re = '[a-zA-Z][a-zA-Z0-9.+\-]*';
+our $scheme_re = '[a-zA-Z][a-zA-Z0-9.+\-]*';
use Carp ();
use URI::Escape ();
@@ -131,7 +131,7 @@ sub implementor
# Try to load it
eval "require $ic";
die $@ if $@ && $@ !~ /Can\'t locate.*in \@INC/;
- return unless @{"${ic}::ISA"};
+ return undef unless @{"${ic}::ISA"};
}
$ic->_init_implementor($scheme);
@@ -155,6 +155,7 @@ sub clone
bless \$other, ref $self;
}
+sub TO_JSON { ${$_[0]} }
sub _no_scheme_ok { 0 }
@@ -163,7 +164,7 @@ sub _scheme
my $self = shift;
unless (@_) {
- return unless $$self =~ /^($scheme_re):/o;
+ return undef unless $$self =~ /^($scheme_re):/o;
return $1;
}
@@ -193,10 +194,14 @@ sub _scheme
sub scheme
{
my $scheme = shift->_scheme(@_);
- return unless defined $scheme;
+ return undef unless defined $scheme;
lc($scheme);
}
+sub has_recognized_scheme {
+ my $self = shift;
+ return ref($self) !~ /^URI::_(?:foreign|generic)\z/;
+}
sub opaque
{
@@ -228,14 +233,14 @@ sub opaque
$old_opaque;
}
-*path = \&opaque; # alias
+sub path { goto &opaque } # alias
sub fragment
{
my $self = shift;
unless (@_) {
- return unless $$self =~ /\#(.*)/s;
+ return undef unless $$self =~ /\#(.*)/s;
return $1;
}
@@ -417,6 +422,11 @@ the $str argument before it is processed further.
The constructor determines the scheme, maps this to an appropriate
URI subclass, constructs a new object of that class and returns it.
+If the scheme isn't one of those that URI recognizes, you still get
+an URI object back that you can access the generic methods on. The
+C<< $uri->has_recognized_scheme >> method can be used to test for
+this.
+
The $scheme argument is only used when $str is a
relative URI. It can be either a simple string that
denotes the scheme, a string containing an absolute URI reference, or
@@ -500,6 +510,14 @@ returned by $uri->scheme is always lowercase. If you want the scheme
just as it was written in the URI in its original case,
you can use the $uri->_scheme method instead.
+=item $uri->has_recognized_scheme
+
+Returns TRUE if the URI scheme is one that URI recognizes.
+
+It will also be TRUE for relative URLs where a recognized
+scheme was provided to the constructor, even if C<< $uri->scheme >>
+returns C<undef> for these.
+
=item $uri->opaque
=item $uri->opaque( $new_opaque )
@@ -585,7 +603,7 @@ a secure channel, such as an SSL or TLS encrypted one.
The following methods are available to schemes that use the
common/generic syntax for hierarchical namespaces. The descriptions of
-schemes below indicate which these are. Unknown schemes are
+schemes below indicate which these are. Unrecognized schemes are
assumed to support the generic syntax, and therefore the following
methods: