summaryrefslogtreecommitdiff
path: root/Master/tlpkg/tlperl/lib/URI
diff options
context:
space:
mode:
authorSiep Kroonenberg <siepo@cybercomm.nl>2011-02-17 12:20:49 +0000
committerSiep Kroonenberg <siepo@cybercomm.nl>2011-02-17 12:20:49 +0000
commit316ee97c621496b0fe3267f57cce81bee44ca1e6 (patch)
treecb2cab1192b4f58a7971af19b213e980bceda4b4 /Master/tlpkg/tlperl/lib/URI
parentcd0f87b5d39480d85ad9bd4ee37f520f75bed560 (diff)
Moving old tlperl prior to committing new one
git-svn-id: svn://tug.org/texlive/trunk@21422 c570f23f-e606-0410-a88d-b1316a301751
Diffstat (limited to 'Master/tlpkg/tlperl/lib/URI')
-rwxr-xr-xMaster/tlpkg/tlperl/lib/URI/Escape.pm218
-rwxr-xr-xMaster/tlpkg/tlperl/lib/URI/Heuristic.pm222
-rwxr-xr-xMaster/tlpkg/tlperl/lib/URI/IRI.pm44
-rwxr-xr-xMaster/tlpkg/tlperl/lib/URI/QueryParam.pm200
-rwxr-xr-xMaster/tlpkg/tlperl/lib/URI/Split.pm96
-rwxr-xr-xMaster/tlpkg/tlperl/lib/URI/URL.pm305
-rwxr-xr-xMaster/tlpkg/tlperl/lib/URI/WithBase.pm171
-rwxr-xr-xMaster/tlpkg/tlperl/lib/URI/_foreign.pm6
-rwxr-xr-xMaster/tlpkg/tlperl/lib/URI/_generic.pm249
-rwxr-xr-xMaster/tlpkg/tlperl/lib/URI/_idna.pm78
-rwxr-xr-xMaster/tlpkg/tlperl/lib/URI/_ldap.pm140
-rwxr-xr-xMaster/tlpkg/tlperl/lib/URI/_login.pm10
-rwxr-xr-xMaster/tlpkg/tlperl/lib/URI/_punycode.pm203
-rwxr-xr-xMaster/tlpkg/tlperl/lib/URI/_query.pm92
-rwxr-xr-xMaster/tlpkg/tlperl/lib/URI/_segment.pm20
-rwxr-xr-xMaster/tlpkg/tlperl/lib/URI/_server.pm162
-rwxr-xr-xMaster/tlpkg/tlperl/lib/URI/_userpass.pm51
-rwxr-xr-xMaster/tlpkg/tlperl/lib/URI/data.pm140
-rwxr-xr-xMaster/tlpkg/tlperl/lib/URI/file.pm329
-rwxr-xr-xMaster/tlpkg/tlperl/lib/URI/file/Base.pm80
-rwxr-xr-xMaster/tlpkg/tlperl/lib/URI/file/FAT.pm23
-rwxr-xr-xMaster/tlpkg/tlperl/lib/URI/file/Mac.pm120
-rwxr-xr-xMaster/tlpkg/tlperl/lib/URI/file/OS2.pm28
-rwxr-xr-xMaster/tlpkg/tlperl/lib/URI/file/QNX.pm18
-rwxr-xr-xMaster/tlpkg/tlperl/lib/URI/file/Unix.pm55
-rwxr-xr-xMaster/tlpkg/tlperl/lib/URI/file/Win32.pm84
-rwxr-xr-xMaster/tlpkg/tlperl/lib/URI/ftp.pm45
-rwxr-xr-xMaster/tlpkg/tlperl/lib/URI/gopher.pm94
-rwxr-xr-xMaster/tlpkg/tlperl/lib/URI/http.pm25
-rwxr-xr-xMaster/tlpkg/tlperl/lib/URI/https.pm7
-rwxr-xr-xMaster/tlpkg/tlperl/lib/URI/ldap.pm122
-rwxr-xr-xMaster/tlpkg/tlperl/lib/URI/ldapi.pm30
-rwxr-xr-xMaster/tlpkg/tlperl/lib/URI/ldaps.pm7
-rwxr-xr-xMaster/tlpkg/tlperl/lib/URI/mailto.pm72
-rwxr-xr-xMaster/tlpkg/tlperl/lib/URI/mms.pm8
-rwxr-xr-xMaster/tlpkg/tlperl/lib/URI/news.pm68
-rwxr-xr-xMaster/tlpkg/tlperl/lib/URI/nntp.pm6
-rwxr-xr-xMaster/tlpkg/tlperl/lib/URI/pop.pm68
-rwxr-xr-xMaster/tlpkg/tlperl/lib/URI/rlogin.pm7
-rwxr-xr-xMaster/tlpkg/tlperl/lib/URI/rsync.pm12
-rwxr-xr-xMaster/tlpkg/tlperl/lib/URI/rtsp.pm8
-rwxr-xr-xMaster/tlpkg/tlperl/lib/URI/rtspu.pm8
-rwxr-xr-xMaster/tlpkg/tlperl/lib/URI/sip.pm86
-rwxr-xr-xMaster/tlpkg/tlperl/lib/URI/sips.pm7
-rwxr-xr-xMaster/tlpkg/tlperl/lib/URI/snews.pm8
-rwxr-xr-xMaster/tlpkg/tlperl/lib/URI/ssh.pm9
-rwxr-xr-xMaster/tlpkg/tlperl/lib/URI/telnet.pm7
-rwxr-xr-xMaster/tlpkg/tlperl/lib/URI/tn3270.pm7
-rwxr-xr-xMaster/tlpkg/tlperl/lib/URI/urn.pm97
-rwxr-xr-xMaster/tlpkg/tlperl/lib/URI/urn/isbn.pm102
-rwxr-xr-xMaster/tlpkg/tlperl/lib/URI/urn/oid.pm18
51 files changed, 0 insertions, 4072 deletions
diff --git a/Master/tlpkg/tlperl/lib/URI/Escape.pm b/Master/tlpkg/tlperl/lib/URI/Escape.pm
deleted file mode 100755
index c2da23becac..00000000000
--- a/Master/tlpkg/tlperl/lib/URI/Escape.pm
+++ /dev/null
@@ -1,218 +0,0 @@
-package URI::Escape;
-use strict;
-
-=head1 NAME
-
-URI::Escape - Escape and unescape unsafe characters
-
-=head1 SYNOPSIS
-
- use URI::Escape;
- $safe = uri_escape("10% is enough\n");
- $verysafe = uri_escape("foo", "\0-\377");
- $str = uri_unescape($safe);
-
-=head1 DESCRIPTION
-
-This module provides functions to escape and unescape URI strings as
-defined by RFC 2396 (and updated by RFC 2732).
-A URI consists of a restricted set of characters,
-denoted as C<uric> in RFC 2396. The restricted set of characters
-consists of digits, letters, and a few graphic symbols chosen from
-those common to most of the character encodings and input facilities
-available to Internet users:
-
- "A" .. "Z", "a" .. "z", "0" .. "9",
- ";", "/", "?", ":", "@", "&", "=", "+", "$", ",", "[", "]", # reserved
- "-", "_", ".", "!", "~", "*", "'", "(", ")"
-
-In addition, any byte (octet) can be represented in a URI by an escape
-sequence: a triplet consisting of the character "%" followed by two
-hexadecimal digits. A byte can also be represented directly by a
-character, using the US-ASCII character for that octet (iff the
-character is part of C<uric>).
-
-Some of the C<uric> characters are I<reserved> for use as delimiters
-or as part of certain URI components. These must be escaped if they are
-to be treated as ordinary data. Read RFC 2396 for further details.
-
-The functions provided (and exported by default) from this module are:
-
-=over 4
-
-=item uri_escape( $string )
-
-=item uri_escape( $string, $unsafe )
-
-Replaces each unsafe character in the $string with the corresponding
-escape sequence and returns the result. The $string argument should
-be a string of bytes. The uri_escape() function will croak if given a
-characters with code above 255. Use uri_escape_utf8() if you know you
-have such chars or/and want chars in the 128 .. 255 range treated as
-UTF-8.
-
-The uri_escape() function takes an optional second argument that
-overrides the set of characters that are to be escaped. The set is
-specified as a string that can be used in a regular expression
-character class (between [ ]). E.g.:
-
- "\x00-\x1f\x7f-\xff" # all control and hi-bit characters
- "a-z" # all lower case characters
- "^A-Za-z" # everything not a letter
-
-The default set of characters to be escaped is all those which are
-I<not> part of the C<uric> character class shown above as well as the
-reserved characters. I.e. the default is:
-
- "^A-Za-z0-9\-_.!~*'()"
-
-=item uri_escape_utf8( $string )
-
-=item uri_escape_utf8( $string, $unsafe )
-
-Works like uri_escape(), but will encode chars as UTF-8 before
-escaping them. This makes this function able do deal with characters
-with code above 255 in $string. Note that chars in the 128 .. 255
-range will be escaped differently by this function compared to what
-uri_escape() would. For chars in the 0 .. 127 range there is no
-difference.
-
-The call:
-
- $uri = uri_escape_utf8($string);
-
-will be the same as:
-
- use Encode qw(encode);
- $uri = uri_escape(encode("UTF-8", $string));
-
-but will even work for perl-5.6 for chars in the 128 .. 255 range.
-
-Note: Javascript has a function called escape() that produces the
-sequence "%uXXXX" for chars in the 256 .. 65535 range. This function
-has really nothing to do with URI escaping but some folks got confused
-since it "does the right thing" in the 0 .. 255 range. Because of
-this you sometimes see "URIs" with these kind of escapes. The
-JavaScript encodeURIComponent() function is similar to uri_escape_utf8().
-
-=item uri_unescape($string,...)
-
-Returns a string with each %XX sequence replaced with the actual byte
-(octet).
-
-This does the same as:
-
- $string =~ s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg;
-
-but does not modify the string in-place as this RE would. Using the
-uri_unescape() function instead of the RE might make the code look
-cleaner and is a few characters less to type.
-
-In a simple benchmark test I did,
-calling the function (instead of the inline RE above) if a few chars
-were unescaped was something like 40% slower, and something like 700% slower if none were. If
-you are going to unescape a lot of times it might be a good idea to
-inline the RE.
-
-If the uri_unescape() function is passed multiple strings, then each
-one is returned unescaped.
-
-=back
-
-The module can also export the C<%escapes> hash, which contains the
-mapping from all 256 bytes to the corresponding escape codes. Lookup
-in this hash is faster than evaluating C<sprintf("%%%02X", ord($byte))>
-each time.
-
-=head1 SEE ALSO
-
-L<URI>
-
-
-=head1 COPYRIGHT
-
-Copyright 1995-2004 Gisle Aas.
-
-This program is free software; you can redistribute it and/or modify
-it under the same terms as Perl itself.
-
-=cut
-
-use vars qw(@ISA @EXPORT @EXPORT_OK $VERSION);
-use vars qw(%escapes);
-
-require Exporter;
-@ISA = qw(Exporter);
-@EXPORT = qw(uri_escape uri_unescape uri_escape_utf8);
-@EXPORT_OK = qw(%escapes);
-$VERSION = "3.29";
-
-use Carp ();
-
-# Build a char->hex map
-for (0..255) {
- $escapes{chr($_)} = sprintf("%%%02X", $_);
-}
-
-my %subst; # compiled patternes
-
-sub uri_escape
-{
- my($text, $patn) = @_;
- return undef unless defined $text;
- if (defined $patn){
- unless (exists $subst{$patn}) {
- # Because we can't compile the regex we fake it with a cached sub
- (my $tmp = $patn) =~ s,/,\\/,g;
- eval "\$subst{\$patn} = sub {\$_[0] =~ s/([$tmp])/\$escapes{\$1} || _fail_hi(\$1)/ge; }";
- Carp::croak("uri_escape: $@") if $@;
- }
- &{$subst{$patn}}($text);
- } else {
- # Default unsafe characters. RFC 2732 ^(uric - reserved)
- $text =~ s/([^A-Za-z0-9\-_.!~*'()])/$escapes{$1} || _fail_hi($1)/ge;
- }
- $text;
-}
-
-sub _fail_hi {
- my $chr = shift;
- Carp::croak(sprintf "Can't escape \\x{%04X}, try uri_escape_utf8() instead", ord($chr));
-}
-
-sub uri_escape_utf8
-{
- my $text = shift;
- if ($] < 5.008) {
- $text =~ s/([^\0-\x7F])/do {my $o = ord($1); sprintf("%c%c", 0xc0 | ($o >> 6), 0x80 | ($o & 0x3f)) }/ge;
- }
- else {
- utf8::encode($text);
- }
-
- return uri_escape($text, @_);
-}
-
-sub uri_unescape
-{
- # Note from RFC1630: "Sequences which start with a percent sign
- # but are not followed by two hexadecimal characters are reserved
- # for future extension"
- my $str = shift;
- if (@_ && wantarray) {
- # not executed for the common case of a single argument
- my @str = ($str, @_); # need to copy
- foreach (@str) {
- s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg;
- }
- return @str;
- }
- $str =~ s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg if defined $str;
- $str;
-}
-
-sub escape_char {
- return join '', @URI::Escape::escapes{$_[0] =~ /(\C)/g};
-}
-
-1;
diff --git a/Master/tlpkg/tlperl/lib/URI/Heuristic.pm b/Master/tlpkg/tlperl/lib/URI/Heuristic.pm
deleted file mode 100755
index eb000609b9d..00000000000
--- a/Master/tlpkg/tlperl/lib/URI/Heuristic.pm
+++ /dev/null
@@ -1,222 +0,0 @@
-package URI::Heuristic;
-
-=head1 NAME
-
-URI::Heuristic - Expand URI using heuristics
-
-=head1 SYNOPSIS
-
- use URI::Heuristic qw(uf_uristr);
- $u = uf_uristr("perl"); # http://www.perl.com
- $u = uf_uristr("www.sol.no/sol"); # http://www.sol.no/sol
- $u = uf_uristr("aas"); # http://www.aas.no
- $u = uf_uristr("ftp.funet.fi"); # ftp://ftp.funet.fi
- $u = uf_uristr("/etc/passwd"); # file:/etc/passwd
-
-=head1 DESCRIPTION
-
-This module provides functions that expand strings into real absolute
-URIs using some built-in heuristics. Strings that already represent
-absolute URIs (i.e. that start with a C<scheme:> part) are never modified
-and are returned unchanged. The main use of these functions is to
-allow abbreviated URIs similar to what many web browsers allow for URIs
-typed in by the user.
-
-The following functions are provided:
-
-=over 4
-
-=item uf_uristr($str)
-
-Tries to make the argument string
-into a proper absolute URI string. The "uf_" prefix stands for "User
-Friendly". Under MacOS, it assumes that any string with a common URL
-scheme (http, ftp, etc.) is a URL rather than a local path. So don't name
-your volumes after common URL schemes and expect uf_uristr() to construct
-valid file: URL's on those volumes for you, because it won't.
-
-=item uf_uri($str)
-
-Works the same way as uf_uristr() but
-returns a C<URI> object.
-
-=back
-
-=head1 ENVIRONMENT
-
-If the hostname portion of a URI does not contain any dots, then
-certain qualified guesses are made. These guesses are governed by
-the following two environment variables:
-
-=over 10
-
-=item COUNTRY
-
-The two-letter country code (ISO 3166) for your location. If
-the domain name of your host ends with two letters, then it is taken
-to be the default country. See also L<Locale::Country>.
-
-=item URL_GUESS_PATTERN
-
-Contains a space-separated list of URL patterns to try. The string
-"ACME" is for some reason used as a placeholder for the host name in
-the URL provided. Example:
-
- URL_GUESS_PATTERN="www.ACME.no www.ACME.se www.ACME.com"
- export URL_GUESS_PATTERN
-
-Specifying URL_GUESS_PATTERN disables any guessing rules based on
-country. An empty URL_GUESS_PATTERN disables any guessing that
-involves host name lookups.
-
-=back
-
-=head1 COPYRIGHT
-
-Copyright 1997-1998, Gisle Aas
-
-This library is free software; you can redistribute it and/or
-modify it under the same terms as Perl itself.
-
-=cut
-
-use strict;
-
-use vars qw(@EXPORT_OK $VERSION $MY_COUNTRY %LOCAL_GUESSING $DEBUG);
-
-require Exporter;
-*import = \&Exporter::import;
-@EXPORT_OK = qw(uf_uri uf_uristr uf_url uf_urlstr);
-$VERSION = "4.18";
-
-sub MY_COUNTRY() {
- for ($MY_COUNTRY) {
- return $_ if defined;
-
- # First try the environment.
- $_ = $ENV{COUNTRY};
- return $_ if defined;
-
- # Could use LANG, LC_ALL, etc at this point, but probably too
- # much of a wild guess. (Catalan != Canada, etc.)
- #
-
- # Last bit of domain name. This may access the network.
- require Net::Domain;
- my $fqdn = Net::Domain::hostfqdn();
- $_ = lc($1) if $fqdn =~ /\.([a-zA-Z]{2})$/;
- return $_ if defined;
-
- # Give up. Defined but false.
- return ($_ = 0);
- }
-}
-
-%LOCAL_GUESSING =
-(
- 'us' => [qw(www.ACME.gov www.ACME.mil)],
- 'uk' => [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)],
- # send corrections and new entries to <gisle@aas.no>
-);
-
-
-sub uf_uristr ($)
-{
- local($_) = @_;
- print STDERR "uf_uristr: resolving $_\n" if $DEBUG;
- return unless defined;
-
- s/^\s+//;
- s/\s+$//;
-
- if (/^(www|web|home)\./) {
- $_ = "http://$_";
-
- } elsif (/^(ftp|gopher|news|wais|http|https)\./) {
- $_ = "$1://$_";
-
- } elsif ($^O ne "MacOS" &&
- (m,^/, || # absolute file name
- m,^\.\.?/, || # relative file name
- m,^[a-zA-Z]:[/\\],) # dosish file name
- )
- {
- $_ = "file:$_";
-
- } elsif ($^O eq "MacOS" && m/:/) {
- # potential MacOS file name
- 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.+\-]*:/) { # no scheme specified
- if (s/^([-\w]+(?:\.[-\w]+)*)([\/:\?\#]|$)/$2/) {
- my $host = $1;
-
- 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;
- }
- }
- $_ = "http://$host$_";
-
- } else {
- # pure junk, just return it unchanged...
-
- }
- }
- print STDERR "uf_uristr: ==> $_\n" if $DEBUG;
-
- $_;
-}
-
-sub uf_uri ($)
-{
- require URI;
- URI->new(uf_uristr($_[0]));
-}
-
-# legacy
-*uf_urlstr = \*uf_uristr;
-
-sub uf_url ($)
-{
- require URI::URL;
- URI::URL->new(uf_uristr($_[0]));
-}
-
-1;
diff --git a/Master/tlpkg/tlperl/lib/URI/IRI.pm b/Master/tlpkg/tlperl/lib/URI/IRI.pm
deleted file mode 100755
index 39336fce5ac..00000000000
--- a/Master/tlpkg/tlperl/lib/URI/IRI.pm
+++ /dev/null
@@ -1,44 +0,0 @@
-package URI::IRI;
-
-# Experimental
-
-use strict;
-use URI ();
-
-use overload '""' => sub { shift->as_string };
-
-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;
-}
-
-sub AUTOLOAD
-{
- use vars qw($AUTOLOAD);
- my $method = substr($AUTOLOAD, rindex($AUTOLOAD, '::')+2);
-
- # We create the function here so that it will not need to be
- # autoloaded the next time.
- no strict 'refs';
- *$method = sub { shift->{uri}->$method(@_) };
- goto &$method;
-}
-
-sub DESTROY {} # avoid AUTOLOADing it
-
-1;
diff --git a/Master/tlpkg/tlperl/lib/URI/QueryParam.pm b/Master/tlpkg/tlperl/lib/URI/QueryParam.pm
deleted file mode 100755
index 3f634b12b77..00000000000
--- a/Master/tlpkg/tlperl/lib/URI/QueryParam.pm
+++ /dev/null
@@ -1,200 +0,0 @@
-package URI::QueryParam;
-
-use strict;
-
-sub URI::_query::query_param {
- my $self = shift;
- my @old = $self->query_form;
-
- if (@_ == 0) {
- # get keys
- my %seen;
- my @keys;
- for (my $i = 0; $i < @old; $i += 2) {
- push(@keys, $old[$i]) unless $seen{$old[$i]}++;
- }
- return @keys;
- }
-
- my $key = shift;
- my @i;
-
- for (my $i = 0; $i < @old; $i += 2) {
- push(@i, $i) if $old[$i] eq $key;
- }
-
- if (@_) {
- my @new = @old;
- my @new_i = @i;
- my @vals = map { ref($_) eq 'ARRAY' ? @$_ : $_ } @_;
- #print "VALS:@vals [@i]\n";
- while (@new_i > @vals) {
- #print "REMOVE $new_i[-1]\n";
- splice(@new, pop(@new_i), 2);
- }
- while (@vals > @new_i) {
- my $i = @new_i ? $new_i[-1] + 2 : @new;
- #print "SPLICE $i\n";
- splice(@new, $i, 0, $key => pop(@vals));
- }
- for (@vals) {
- #print "SET $new_i[0]\n";
- $new[shift(@new_i)+1] = $_;
- }
-
- $self->query_form(\@new);
- }
-
- return wantarray ? @old[map $_+1, @i] : @i ? $old[$i[0]+1] : undef;
-}
-
-sub URI::_query::query_param_append {
- my $self = shift;
- my $key = shift;
- $self->query_form($self->query_form, $key => \@_); # XXX
- return;
-}
-
-sub URI::_query::query_param_delete {
- my $self = shift;
- my $key = shift;
- my @old = $self->query_form;
- my @vals;
-
- for (my $i = @old - 2; $i >= 0; $i -= 2) {
- next if $old[$i] ne $key;
- push(@vals, (splice(@old, $i, 2))[1]);
- }
- $self->query_form(\@old) if @vals;
- return wantarray ? reverse @vals : $vals[-1];
-}
-
-sub URI::_query::query_form_hash {
- my $self = shift;
- my @old = $self->query_form;
- if (@_) {
- $self->query_form(@_ == 1 ? %{shift(@_)} : @_);
- }
- my %hash;
- while (my($k, $v) = splice(@old, 0, 2)) {
- if (exists $hash{$k}) {
- for ($hash{$k}) {
- $_ = [$_] unless ref($_) eq "ARRAY";
- push(@$_, $v);
- }
- }
- else {
- $hash{$k} = $v;
- }
- }
- return \%hash;
-}
-
-1;
-
-__END__
-
-=head1 NAME
-
-URI::QueryParam - Additional query methods for URIs
-
-=head1 SYNOPSIS
-
- use URI;
- use URI::QueryParam;
-
- $u = URI->new("", "http");
- $u->query_param(foo => 1, 2, 3);
- print $u->query; # prints foo=1&foo=2&foo=3
-
- for my $key ($u->query_param) {
- print "$key: ", join(", ", $u->query_param($key)), "\n";
- }
-
-=head1 DESCRIPTION
-
-Loading the C<URI::QueryParam> module adds some extra methods to
-URIs that support query methods. These methods provide an alternative
-interface to the $u->query_form data.
-
-The query_param_* methods have deliberately been made identical to the
-interface of the corresponding C<CGI.pm> methods.
-
-The following additional methods are made available:
-
-=over
-
-=item @keys = $u->query_param
-
-=item @values = $u->query_param( $key )
-
-=item $first_value = $u->query_param( $key )
-
-=item $u->query_param( $key, $value,... )
-
-If $u->query_param is called with no arguments, it returns all the
-distinct parameter keys of the URI. In a scalar context it returns the
-number of distinct keys.
-
-When a $key argument is given, the method returns the parameter values with the
-given key. In a scalar context, only the first parameter value is
-returned.
-
-If additional arguments are given, they are used to update successive
-parameters with the given key. If any of the values provided are
-array references, then the array is dereferenced to get the actual
-values.
-
-=item $u->query_param_append($key, $value,...)
-
-Adds new parameters with the given
-key without touching any old parameters with the same key. It
-can be explained as a more efficient version of:
-
- $u->query_param($key,
- $u->query_param($key),
- $value,...);
-
-One difference is that this expression would return the old values
-of $key, whereas the query_param_append() method does not.
-
-=item @values = $u->query_param_delete($key)
-
-=item $first_value = $u->query_param_delete($key)
-
-Deletes all key/value pairs with the given key.
-The old values are returned. In a scalar context, only the first value
-is returned.
-
-Using the query_param_delete() method is slightly more efficient than
-the equivalent:
-
- $u->query_param($key, []);
-
-=item $hashref = $u->query_form_hash
-
-=item $u->query_form_hash( \%new_form )
-
-Returns a reference to a hash that represents the
-query form's key/value pairs. If a key occurs multiple times, then the hash
-value becomes an array reference.
-
-Note that sequence information is lost. This means that:
-
- $u->query_form_hash($u->query_form_hash);
-
-is not necessarily a no-op, as it may reorder the key/value pairs.
-The values returned by the query_param() method should stay the same
-though.
-
-=back
-
-=head1 SEE ALSO
-
-L<URI>, L<CGI>
-
-=head1 COPYRIGHT
-
-Copyright 2002 Gisle Aas.
-
-=cut
diff --git a/Master/tlpkg/tlperl/lib/URI/Split.pm b/Master/tlpkg/tlperl/lib/URI/Split.pm
deleted file mode 100755
index ad430b93277..00000000000
--- a/Master/tlpkg/tlperl/lib/URI/Split.pm
+++ /dev/null
@@ -1,96 +0,0 @@
-package URI::Split;
-
-use strict;
-
-use vars qw(@ISA @EXPORT_OK);
-require Exporter;
-@ISA = qw(Exporter);
-@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 .= "//"; # XXX force empty auth
- }
- 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;
-
-__END__
-
-=head1 NAME
-
-URI::Split - Parse and compose URI strings
-
-=head1 SYNOPSIS
-
- use URI::Split qw(uri_split uri_join);
- ($scheme, $auth, $path, $query, $frag) = uri_split($uri);
- $uri = uri_join($scheme, $auth, $path, $query, $frag);
-
-=head1 DESCRIPTION
-
-Provides functions to parse and compose URI
-strings. The following functions are provided:
-
-=over
-
-=item ($scheme, $auth, $path, $query, $frag) = uri_split($uri)
-
-Breaks up a URI string into its component
-parts. An C<undef> value is returned for those parts that are not
-present. The $path part is always present (but can be the empty
-string) and is thus never returned as C<undef>.
-
-No sensible value is returned if this function is called in a scalar
-context.
-
-=item $uri = uri_join($scheme, $auth, $path, $query, $frag)
-
-Puts together a URI string from its parts.
-Missing parts are signaled by passing C<undef> for the corresponding
-argument.
-
-Minimal escaping is applied to parts that contain reserved chars
-that would confuse a parser. For instance, any occurrence of '?' or '#'
-in $path is always escaped, as it would otherwise be parsed back
-as a query or fragment.
-
-=back
-
-=head1 SEE ALSO
-
-L<URI>, L<URI::Escape>
-
-=head1 COPYRIGHT
-
-Copyright 2003, Gisle Aas
-
-This library is free software; you can redistribute it and/or
-modify it under the same terms as Perl itself.
-
-=cut
diff --git a/Master/tlpkg/tlperl/lib/URI/URL.pm b/Master/tlpkg/tlperl/lib/URI/URL.pm
deleted file mode 100755
index 77354488c86..00000000000
--- a/Master/tlpkg/tlperl/lib/URI/URL.pm
+++ /dev/null
@@ -1,305 +0,0 @@
-package URI::URL;
-
-require URI::WithBase;
-@ISA=qw(URI::WithBase);
-
-use strict;
-use vars qw(@EXPORT $VERSION);
-
-$VERSION = "5.03";
-
-# Provide as much as possible of the old URI::URL interface for backwards
-# compatibility...
-
-require Exporter;
-*import = \&Exporter::import;
-@EXPORT = qw(url);
-
-# Easy to use constructor
-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 # hope it is not defined
- {
- 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
-{
- # should be overridden by subclasses
- 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 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])/) { # contains escaped '=' '&' or '+'
- 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)");
- }
- }
- # Now it should be safe to unescape the string without loosing
- # information
- 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(@_); }
-
-# file:
-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"); }
-
-# mailto:
-sub address { shift->to(@_); }
-sub encoded822addr { shift->to(@_); }
-sub URI::mailto::authority { shift->to(@_); } # make 'netloc' method work
-
-# news:
-sub groupart { shift->_group(@_); }
-sub article { shift->message(@_); }
-
-1;
-
-__END__
-
-=head1 NAME
-
-URI::URL - Uniform Resource Locators
-
-=head1 SYNOPSIS
-
- $u1 = URI::URL->new($str, $base);
- $u2 = $u1->abs;
-
-=head1 DESCRIPTION
-
-This module is provided for backwards compatibility with modules that
-depend on the interface provided by the C<URI::URL> class that used to
-be distributed with the libwww-perl library.
-
-The following differences exist compared to the C<URI> class interface:
-
-=over 3
-
-=item *
-
-The URI::URL module exports the url() function as an alternate
-constructor interface.
-
-=item *
-
-The constructor takes an optional $base argument. The C<URI::URL>
-class is a subclass of C<URI::WithBase>.
-
-=item *
-
-The URI::URL->newlocal class method is the same as URI::file->new_abs.
-
-=item *
-
-URI::URL::strict(1)
-
-=item *
-
-$url->print_on method
-
-=item *
-
-$url->crack method
-
-=item *
-
-$url->full_path: same as ($uri->abs_path || "/")
-
-=item *
-
-$url->netloc: same as $uri->authority
-
-=item *
-
-$url->epath, $url->equery: same as $uri->path, $uri->query
-
-=item *
-
-$url->path and $url->query pass unescaped strings.
-
-=item *
-
-$url->path_components: same as $uri->path_segments (if you don't
-consider path segment parameters)
-
-=item *
-
-$url->params and $url->eparams methods
-
-=item *
-
-$url->base method. See L<URI::WithBase>.
-
-=item *
-
-$url->abs and $url->rel have an optional $base argument. See
-L<URI::WithBase>.
-
-=item *
-
-$url->frag: same as $uri->fragment
-
-=item *
-
-$url->keywords: same as $uri->query_keywords
-
-=item *
-
-$url->localpath and friends map to $uri->file.
-
-=item *
-
-$url->address and $url->encoded822addr: same as $uri->to for mailto URI
-
-=item *
-
-$url->groupart method for news URI
-
-=item *
-
-$url->article: same as $uri->message
-
-=back
-
-
-
-=head1 SEE ALSO
-
-L<URI>, L<URI::WithBase>
-
-=head1 COPYRIGHT
-
-Copyright 1998-2000 Gisle Aas.
-
-=cut
diff --git a/Master/tlpkg/tlperl/lib/URI/WithBase.pm b/Master/tlpkg/tlperl/lib/URI/WithBase.pm
deleted file mode 100755
index 0337c6b6450..00000000000
--- a/Master/tlpkg/tlperl/lib/URI/WithBase.pm
+++ /dev/null
@@ -1,171 +0,0 @@
-package URI::WithBase;
-
-use strict;
-use vars qw($AUTOLOAD $VERSION);
-use URI;
-
-$VERSION = "2.19";
-
-use overload '""' => "as_string", fallback => 1;
-
-sub as_string; # help overload find it
-
-sub new
-{
- my($class, $uri, $base) = @_;
- my $ibase = $base;
- if ($base && ref($base) && UNIVERSAL::isa($base, __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 UNIVERSAL::isa($other, __PACKAGE__);
- $self->[0]->eq($other);
-}
-
-sub AUTOLOAD
-{
- my $self = shift;
- my $method = substr($AUTOLOAD, rindex($AUTOLOAD, '::')+2);
- return if $method eq "DESTROY";
- $self->[0]->$method(@_);
-}
-
-sub can { # override UNIVERSAL::can
- my $self = shift;
- $self->SUPER::can(@_) || (
- ref($self)
- ? $self->[0]->can(@_)
- : undef
- )
-}
-
-sub base {
- my $self = shift;
- my $base = $self->[1];
-
- if (@_) { # set
- my $new_base = shift;
- # ensure absoluteness
- $new_base = $new_base->abs if ref($new_base) && $new_base->isa(__PACKAGE__);
- $self->[1] = $new_base;
- }
- return unless defined wantarray;
-
- # The base attribute supports 'lazy' conversion from URL strings
- # to URL objects. Strings may be stored but when a string is
- # fetched it will automatically be converted to a URL object.
- # The main benefit is to make it much cheaper to say:
- # URI::WithBase->new($random_url_string, 'http:')
- 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;
-
-__END__
-
-=head1 NAME
-
-URI::WithBase - URIs which remember their base
-
-=head1 SYNOPSIS
-
- $u1 = URI::WithBase->new($str, $base);
- $u2 = $u1->abs;
-
- $base = $u1->base;
- $u1->base( $new_base )
-
-=head1 DESCRIPTION
-
-This module provides the C<URI::WithBase> class. Objects of this class
-are like C<URI> objects, but can keep their base too. The base
-represents the context where this URI was found and can be used to
-absolutize or relativize the URI. All the methods described in L<URI>
-are supported for C<URI::WithBase> objects.
-
-The methods provided in addition to or modified from those of C<URI> are:
-
-=over 4
-
-=item $uri = URI::WithBase->new($str, [$base])
-
-The constructor takes an optional base URI as the second argument.
-If provided, this argument initializes the base attribute.
-
-=item $uri->base( [$new_base] )
-
-Can be used to get or set the value of the base attribute.
-The return value, which is the old value, is a URI object or C<undef>.
-
-=item $uri->abs( [$base_uri] )
-
-The $base_uri argument is now made optional as the object carries its
-base with it. A new object is returned even if $uri is already
-absolute (while plain URI objects simply return themselves in
-that case).
-
-=item $uri->rel( [$base_uri] )
-
-The $base_uri argument is now made optional as the object carries its
-base with it. A new object is always returned.
-
-=back
-
-
-=head1 SEE ALSO
-
-L<URI>
-
-=head1 COPYRIGHT
-
-Copyright 1998-2002 Gisle Aas.
-
-=cut
diff --git a/Master/tlpkg/tlperl/lib/URI/_foreign.pm b/Master/tlpkg/tlperl/lib/URI/_foreign.pm
deleted file mode 100755
index 075f0fd3417..00000000000
--- a/Master/tlpkg/tlperl/lib/URI/_foreign.pm
+++ /dev/null
@@ -1,6 +0,0 @@
-package URI::_foreign;
-
-require URI::_generic;
-@ISA=qw(URI::_generic);
-
-1;
diff --git a/Master/tlpkg/tlperl/lib/URI/_generic.pm b/Master/tlpkg/tlperl/lib/URI/_generic.pm
deleted file mode 100755
index 2a02332853c..00000000000
--- a/Master/tlpkg/tlperl/lib/URI/_generic.pm
+++ /dev/null
@@ -1,249 +0,0 @@
-package URI::_generic;
-require URI;
-require URI::_query;
-@ISA=qw(URI URI::_query);
-
-use strict;
-use URI::Escape qw(uri_unescape);
-use Carp ();
-
-my $ACHAR = $URI::uric; $ACHAR =~ s,\\[/?],,g;
-my $PCHAR = $URI::uric; $PCHAR =~ s,\\[?],,g;
-
-sub _no_scheme_ok { 1 }
-
-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;
- $$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;
- _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;
- _check_path($new_path, $$self);
- $$self .= $new_path . $rest;
- }
- $2;
-}
-
-sub _check_path
-{
- my($path, $pre) = @_;
- my $prefix;
- if ($pre =~ m,/,) { # authority present
- $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 = @_; # make a copy
- 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;
- $abs->fragment($self->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) {
- #print "$i ", join("/", @p), " ($p[$i])\n";
- 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 "."; # trailing "/."
- if ($URI::ABS_REMOTE_LEADING_DOTS) {
- shift @p while @p && $p[0] =~ /^\.\.?$/;
- }
- $abs->path("/" . join("/", @p));
- $abs;
-}
-
-# The oposite of $url->abs. Return a URI which is as relative as possible
-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, $auth, $path) = @{$rel}{qw(scheme authority path)};
- my $scheme = $rel->scheme;
- my $auth = $rel->canonical->authority;
- my $path = $rel->path;
-
- if (!defined($scheme) && !defined($auth)) {
- # it is already relative
- return $rel;
- }
-
- #my($bscheme, $bauth, $bpath) = @{$base}{qw(scheme authority path)};
- 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) {
- # different location, can't make it relative
- return $rel;
- }
-
- for ($path, $bpath) { $_ = "/$_" unless m,^/,; }
-
- # Make it relative by eliminating scheme and authority
- $rel->scheme(undef);
- $rel->authority(undef);
-
- # This loop is based on code from Nicolai Langfeldt <janl@ifi.uio.no>.
- # First we calculate common initial path components length ($li).
- 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;
- }
- # then we nuke it from both paths
- substr($path, 0,$li) = '';
- substr($bpath,0,$li) = '';
-
- if ($path eq $bpath &&
- defined($rel->fragment) &&
- !defined($rel->query)) {
- $rel->path("");
- }
- else {
- # Add one "../" for each path component left in the base path
- $path = ('../' x $bpath =~ tr|/|/|) . $path;
- $path = "./" if $path eq "";
- $rel->path($path);
- }
-
- $rel;
-}
-
-1;
diff --git a/Master/tlpkg/tlperl/lib/URI/_idna.pm b/Master/tlpkg/tlperl/lib/URI/_idna.pm
deleted file mode 100755
index 39366e5b831..00000000000
--- a/Master/tlpkg/tlperl/lib/URI/_idna.pm
+++ /dev/null
@@ -1,78 +0,0 @@
-package URI::_idna;
-
-# This module implements the RFCs 3490 (IDNA) and 3491 (Nameprep)
-# based on Python-2.6.4/Lib/encodings/idna.py
-
-use strict;
-use URI::_punycode qw(encode_punycode decode_punycode);
-use Carp qw(croak);
-
-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 join(".", @labels, @last_empty);
-}
-
-sub decode {
- my $domain = shift;
- return join(".", map ToUnicode($_), split(/\./, $domain, -1))
-}
-
-sub nameprep { # XXX real implementation missing
- 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;
-
- # Step 2: nameprep
- $label = nameprep($label);
- # Step 3: UseSTD3ASCIIRules is false
- # Step 4: try ASCII again
- return check_size($label) if $label =~ $ASCII;
-
- # Step 5: Check ACE prefix
- if ($label =~ /^xn--/) {
- croak "Label starts with ACE prefix";
- }
-
- # Step 6: Encode with PUNYCODE
- $label = encode_punycode($label);
-
- # Step 7: Prepend ACE prefix
- $label = "xn--$label";
-
- # Step 8: Check size
- 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;
diff --git a/Master/tlpkg/tlperl/lib/URI/_ldap.pm b/Master/tlpkg/tlperl/lib/URI/_ldap.pm
deleted file mode 100755
index 608dbd339a3..00000000000
--- a/Master/tlpkg/tlperl/lib/URI/_ldap.pm
+++ /dev/null
@@ -1,140 +0,0 @@
-# Copyright (c) 1998 Graham Barr <gbarr@pobox.com>. All rights reserved.
-# This program is free software; you can redistribute it and/or
-# modify it under the same terms as Perl itself.
-
-package URI::_ldap;
-
-use strict;
-
-use vars qw($VERSION);
-$VERSION = "1.10";
-
-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 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 unless defined wantarray && defined $old;
- uri_unescape($old); # || "(objectClass=*)";
-}
-
-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;
-
- # The stuff below is not as efficient as one might hope...
-
- $other = $other->clone if $other == $self;
-
- $other->dn(_normalize_dn($other->dn));
-
- # Should really know about mixed case "postalAddress", etc...
- $other->attributes(map lc, $other->attributes);
-
- # Lowecase scope, remove default
- 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;
-
- # Remove filter if default
- my $old_filter = $other->filter;
- $other->filter("") if lc($old_filter) eq "(objectclass=*)" ||
- lc($old_filter) eq "objectclass=*";
-
- # Lowercase extensions types and deal with known extension values
- 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 # RFC 2253
-{
- my $dn = shift;
-
- return $dn;
- # The code below will fail if the "+" or "," is embedding in a quoted
- # string or simply escaped...
-
- my @dn = split(/([+,])/, $dn);
- for (@dn) {
- s/^([a-zA-Z]+=)/lc($1)/e;
- }
- join("", @dn);
-}
-
-1;
diff --git a/Master/tlpkg/tlperl/lib/URI/_login.pm b/Master/tlpkg/tlperl/lib/URI/_login.pm
deleted file mode 100755
index 4583f20a9a6..00000000000
--- a/Master/tlpkg/tlperl/lib/URI/_login.pm
+++ /dev/null
@@ -1,10 +0,0 @@
-package URI::_login;
-
-require URI::_server;
-require URI::_userpass;
-@ISA = qw(URI::_server URI::_userpass);
-
-# Generic terminal logins. This is used as a base class for 'telnet',
-# 'tn3270', and 'rlogin' URL schemes.
-
-1;
diff --git a/Master/tlpkg/tlperl/lib/URI/_punycode.pm b/Master/tlpkg/tlperl/lib/URI/_punycode.pm
deleted file mode 100755
index e5600327a06..00000000000
--- a/Master/tlpkg/tlperl/lib/URI/_punycode.pm
+++ /dev/null
@@ -1,203 +0,0 @@
-package URI::_punycode;
-
-use strict;
-our $VERSION = 0.02;
-
-require Exporter;
-our @ISA = qw(Exporter);
-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; # doesn't work in 5.6.x!
- my @input = map substr($input, $_, 1), 0..length($input)-1;
-
- 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;
-__END__
-
-=head1 NAME
-
-URI::_punycode - encodes Unicode string in Punycode
-
-=head1 SYNOPSIS
-
- use URI::_punycode;
- $punycode = encode_punycode($unicode);
- $unicode = decode_punycode($punycode);
-
-=head1 DESCRIPTION
-
-URI::_punycode is a module to encode / decode Unicode strings into
-Punycode, an efficient encoding of Unicode for use with IDNA.
-
-This module requires Perl 5.6.0 or over to handle UTF8 flagged Unicode
-strings.
-
-=head1 FUNCTIONS
-
-This module exports following functions by default.
-
-=over 4
-
-=item encode_punycode
-
- $punycode = encode_punycode($unicode);
-
-takes Unicode string (UTF8-flagged variable) and returns Punycode
-encoding for it.
-
-=item decode_punycode
-
- $unicode = decode_punycode($punycode)
-
-takes Punycode encoding and returns original Unicode string.
-
-=back
-
-These functions throws exceptionsn on failure. You can catch 'em via
-C<eval>.
-
-=head1 AUTHOR
-
-Tatsuhiko Miyagawa E<lt>miyagawa@bulknews.netE<gt> is the author of
-IDNA::Punycode v0.02 which was the basis for this module.
-
-This library is free software; you can redistribute it and/or modify
-it under the same terms as Perl itself.
-
-=head1 SEE ALSO
-
-L<IDNA::Punycode>, RFC 3492
-
-=cut
diff --git a/Master/tlpkg/tlperl/lib/URI/_query.pm b/Master/tlpkg/tlperl/lib/URI/_query.pm
deleted file mode 100755
index 0c6aa285e42..00000000000
--- a/Master/tlpkg/tlperl/lib/URI/_query.pm
+++ /dev/null
@@ -1,92 +0,0 @@
-package URI::_query;
-
-use strict;
-use URI ();
-use URI::Escape qw(uri_unescape);
-
-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;
- $$self .= "?$q";
- }
- $$self .= $3;
- }
- $2;
-}
-
-# Handle ...?foo=bar&bar=foo type of query
-sub query_form {
- my $self = shift;
- my $old = $self->query;
- if (@_) {
- # Try to set query string
- my $delim;
- my $r = $_[0];
- if (ref($r) eq "ARRAY") {
- $delim = $_[1];
- @_ = @$r;
- }
- elsif (ref($r) eq "HASH") {
- $delim = $_[1];
- @_ = %$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 = [ref($vals) eq "ARRAY" ? @$vals : $vals];
- for my $val (@$vals) {
- $val = '' unless defined $val;
- $val =~ s/([;\/?:@&=+,\$\[\]%])/ URI::Escape::escape_char($1)/eg;
- $val =~ s/ /+/g;
- push(@query, "$key=$val");
- }
- }
- if (@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 =~ /=/; # not a form
- map { s/\+/ /g; uri_unescape($_) }
- map { /=/ ? split(/=/, $_, 2) : ($_ => '')} split(/[&;]/, $old);
-}
-
-# Handle ...?dog+bones type of query
-sub query_keywords
-{
- my $self = shift;
- my $old = $self->query;
- if (@_) {
- # Try to set query string
- my @copy = @_;
- @copy = @{$copy[0]} if @copy == 1 && ref($copy[0]) eq "ARRAY";
- for (@copy) { s/([;\/?:@&=+,\$\[\]%])/ URI::Escape::escape_char($1)/eg; }
- $self->query(@copy ? join('+', @copy) : undef);
- }
- return if !defined($old) || !defined(wantarray);
- return if $old =~ /=/; # not keywords, but a form
- map { uri_unescape($_) } split(/\+/, $old, -1);
-}
-
-# Some URI::URL compatibility stuff
-*equery = \&query;
-
-1;
diff --git a/Master/tlpkg/tlperl/lib/URI/_segment.pm b/Master/tlpkg/tlperl/lib/URI/_segment.pm
deleted file mode 100755
index c91b69608e3..00000000000
--- a/Master/tlpkg/tlperl/lib/URI/_segment.pm
+++ /dev/null
@@ -1,20 +0,0 @@
-package URI::_segment;
-
-# Represents a generic path_segment so that it can be treated as
-# a string too.
-
-use strict;
-use URI::Escape qw(uri_unescape);
-
-use overload '""' => sub { $_[0]->[0] },
- fallback => 1;
-
-sub new
-{
- my $class = shift;
- my @segment = split(';', shift, -1);
- $segment[0] = uri_unescape($segment[0]);
- bless \@segment, $class;
-}
-
-1;
diff --git a/Master/tlpkg/tlperl/lib/URI/_server.pm b/Master/tlpkg/tlperl/lib/URI/_server.pm
deleted file mode 100755
index f72ec22657b..00000000000
--- a/Master/tlpkg/tlperl/lib/URI/_server.pm
+++ /dev/null
@@ -1,162 +0,0 @@
-package URI::_server;
-require URI::_generic;
-@ISA=qw(URI::_generic);
-
-use strict;
-use URI::Escape qw(uri_unescape);
-
-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 unless $_[0] =~ /[^URI::uric]/;
- 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/.*@//; # remove old stuff
- my $ui = shift;
- if (defined $ui) {
- $ui =~ s/@/%40/g; # protect @
- $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; # protect @
- if ($new =~ /^[^:]*:\d*\z/ || $new =~ /]:\d*\z/) {
- $new =~ s/(:\d*)\z// || die "Assert";
- $port = $1;
- }
- $new = "[$new]" if $new =~ /:/ && $new !~ /^\[/; # IPv6 address
- _host_escape($new);
- }
- $self->authority("$ui$new$port");
- }
- return undef unless defined $old;
- $old =~ s/.*@//;
- $old =~ s/:\d+$//; # remove the port
- $old =~ s{^\[(.*)\]$}{$1}; # remove brackets around IPv6 (RFC 3986 3.2.2)
- 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/.*@//; # zap userinfo
- $old =~ s/:$//; # empty port should be treated the same a no port
- $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;
diff --git a/Master/tlpkg/tlperl/lib/URI/_userpass.pm b/Master/tlpkg/tlperl/lib/URI/_userpass.pm
deleted file mode 100755
index a0361ae0dd7..00000000000
--- a/Master/tlpkg/tlperl/lib/URI/_userpass.pm
+++ /dev/null
@@ -1,51 +0,0 @@
-package URI::_userpass;
-
-use strict;
-use URI::Escape qw(uri_unescape);
-
-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 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) && !length($user)) {
- $self->userinfo(undef);
- } else {
- $new = "" unless defined($new);
- $new =~ s/%/%25/g;
- $self->userinfo("$user:$new");
- }
- }
- return unless defined $info;
- return unless $info =~ s/^[^:]*://;
- uri_unescape($info);
-}
-
-1;
diff --git a/Master/tlpkg/tlperl/lib/URI/data.pm b/Master/tlpkg/tlperl/lib/URI/data.pm
deleted file mode 100755
index dccd8181289..00000000000
--- a/Master/tlpkg/tlperl/lib/URI/data.pm
+++ /dev/null
@@ -1,140 +0,0 @@
-package URI::data; # RFC 2397
-
-require URI;
-@ISA=qw(URI);
-
-use strict;
-
-use MIME::Base64 qw(encode_base64 decode_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; # media_type can't really be "0"
- "text/plain;charset=US-ASCII"; # default type
-}
-
-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; # because of ";base64" marker
- 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;
-}
-
-# I could not find a better way to interpolate the tr/// chars from
-# a variable.
-my $ENC = $URI::uric;
-$ENC =~ s/%//;
-
-eval <<EOT; die $@ if $@;
-sub _uric_count
-{
- \$_[0] =~ tr/$ENC//;
-}
-EOT
-
-1;
-
-__END__
-
-=head1 NAME
-
-URI::data - URI that contains immediate data
-
-=head1 SYNOPSIS
-
- use URI;
-
- $u = URI->new("data:");
- $u->media_type("image/gif");
- $u->data(scalar(`cat camel.gif`));
- print "$u\n";
- open(XV, "|xv -") and print XV $u->data;
-
-=head1 DESCRIPTION
-
-The C<URI::data> class supports C<URI> objects belonging to the I<data>
-URI scheme. The I<data> URI scheme is specified in RFC 2397. It
-allows inclusion of small data items as "immediate" data, as if it had
-been included externally. Examples:
-
- data:,Perl%20is%20good
-
- data:image/gif;base64,R0lGODdhIAAgAIAAAAAAAPj8+CwAAAAAI
- AAgAAAClYyPqcu9AJyCjtIKc5w5xP14xgeO2tlY3nWcajmZZdeJcG
- Kxrmimms1KMTa1Wg8UROx4MNUq1HrycMjHT9b6xKxaFLM6VRKzI+p
- KS9XtXpcbdun6uWVxJXA8pNPkdkkxhxc21LZHFOgD2KMoQXa2KMWI
- JtnE2KizVUkYJVZZ1nczBxXlFopZBtoJ2diXGdNUymmJdFMAADs=
-
-
-
-C<URI> objects belonging to the data scheme support the common methods
-(described in L<URI>) and the following two scheme-specific methods:
-
-=over 4
-
-=item $uri->media_type( [$new_media_type] )
-
-Can be used to get or set the media type specified in the
-URI. If no media type is specified, then the default
-C<"text/plain;charset=US-ASCII"> is returned.
-
-=item $uri->data( [$new_data] )
-
-Can be used to get or set the data contained in the URI.
-The data is passed unescaped (in binary form). The decision about
-whether to base64 encode the data in the URI is taken automatically,
-based on the encoding that produces the shorter URI string.
-
-=back
-
-=head1 SEE ALSO
-
-L<URI>
-
-=head1 COPYRIGHT
-
-Copyright 1995-1998 Gisle Aas.
-
-This library is free software; you can redistribute it and/or
-modify it under the same terms as Perl itself.
-
-=cut
diff --git a/Master/tlpkg/tlperl/lib/URI/file.pm b/Master/tlpkg/tlperl/lib/URI/file.pm
deleted file mode 100755
index 0ce42529566..00000000000
--- a/Master/tlpkg/tlperl/lib/URI/file.pm
+++ /dev/null
@@ -1,329 +0,0 @@
-package URI::file;
-
-use strict;
-use vars qw(@ISA $VERSION $DEFAULT_AUTHORITY %OS_CLASS);
-
-require URI::_generic;
-@ISA = qw(URI::_generic);
-$VERSION = "4.20";
-
-use URI::Escape qw(uri_unescape);
-
-$DEFAULT_AUTHORITY = "";
-
-# Map from $^O values to implementation classes. The Unix
-# class is the default.
-%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 path { shift->path_query(@_) }
-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); # relative
-
- if (!defined($auth) ||
- $auth eq "" ||
- lc($auth) eq "localhost" ||
- (defined($DEFAULT_AUTHORITY) && lc($auth) eq lc($DEFAULT_AUTHORITY))
- )
- {
- # avoid cloning if $auth already match
- 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;
-
-__END__
-
-=head1 NAME
-
-URI::file - URI that maps to local file names
-
-=head1 SYNOPSIS
-
- use URI::file;
-
- $u1 = URI->new("file:/foo/bar");
- $u2 = URI->new("foo/bar", "file");
-
- $u3 = URI::file->new($path);
- $u4 = URI::file->new("c:\\windows\\", "win32");
-
- $u1->file;
- $u1->file("mac");
-
-=head1 DESCRIPTION
-
-The C<URI::file> class supports C<URI> objects belonging to the I<file>
-URI scheme. This scheme allows us to map the conventional file names
-found on various computer systems to the URI name space. An old
-specification of the I<file> URI scheme is found in RFC 1738. Some
-older background information is also in RFC 1630. There are no newer
-specifications as far as I know.
-
-If you simply want to construct I<file> URI objects from URI strings,
-use the normal C<URI> constructor. If you want to construct I<file>
-URI objects from the actual file names used by various systems, then
-use one of the following C<URI::file> constructors:
-
-=over 4
-
-=item $u = URI::file->new( $filename, [$os] )
-
-Maps a file name to the I<file:> URI name space, creates a URI object
-and returns it. The $filename is interpreted as belonging to the
-indicated operating system ($os), which defaults to the value of the
-$^O variable. The $filename can be either absolute or relative, and
-the corresponding type of URI object for $os is returned.
-
-=item $u = URI::file->new_abs( $filename, [$os] )
-
-Same as URI::file->new, but makes sure that the URI returned
-represents an absolute file name. If the $filename argument is
-relative, then the name is resolved relative to the current directory,
-i.e. this constructor is really the same as:
-
- URI::file->new($filename)->abs(URI::file->cwd);
-
-=item $u = URI::file->cwd
-
-Returns a I<file> URI that represents the current working directory.
-See L<Cwd>.
-
-=back
-
-The following methods are supported for I<file> URI (in addition to
-the common and generic methods described in L<URI>):
-
-=over 4
-
-=item $u->file( [$os] )
-
-Returns a file name. It maps from the URI name space
-to the file name space of the indicated operating system.
-
-It might return C<undef> if the name can not be represented in the
-indicated file system.
-
-=item $u->dir( [$os] )
-
-Some systems use a different form for names of directories than for plain
-files. Use this method if you know you want to use the name for
-a directory.
-
-=back
-
-The C<URI::file> module can be used to map generic file names to names
-suitable for the current system. As such, it can work as a nice
-replacement for the C<File::Spec> module. For instance, the following
-code translates the UNIX-style file name F<Foo/Bar.pm> to a name
-suitable for the local system:
-
- $file = URI::file->new("Foo/Bar.pm", "unix")->file;
- die "Can't map filename Foo/Bar.pm for $^O" unless defined $file;
- open(FILE, $file) || die "Can't open '$file': $!";
- # do something with FILE
-
-=head1 MAPPING NOTES
-
-Most computer systems today have hierarchically organized file systems.
-Mapping the names used in these systems to the generic URI syntax
-allows us to work with relative file URIs that behave as they should
-when resolved using the generic algorithm for URIs (specified in RFC
-2396). Mapping a file name to the generic URI syntax involves mapping
-the path separator character to "/" and encoding any reserved
-characters that appear in the path segments of the file name. If
-path segments consisting of the strings "." or ".." have a
-different meaning than what is specified for generic URIs, then these
-must be encoded as well.
-
-If the file system has device, volume or drive specifications as
-the root of the name space, then it makes sense to map them to the
-authority field of the generic URI syntax. This makes sure that
-relative URIs can not be resolved "above" them, i.e. generally how
-relative file names work in those systems.
-
-Another common use of the authority field is to encode the host on which
-this file name is valid. The host name "localhost" is special and
-generally has the same meaning as a missing or empty authority
-field. This use is in conflict with using it as a device
-specification, but can often be resolved for device specifications
-having characters not legal in plain host names.
-
-File name to URI mapping in normally not one-to-one. There are
-usually many URIs that map to any given file name. For instance, an
-authority of "localhost" maps the same as a URI with a missing or empty
-authority.
-
-Example 1: The Mac uses ":" as path separator, but not in the same way
-as a generic URI. ":foo" is a relative name. "foo:bar" is an absolute
-name. Also, path segments can contain the "/" character as well as the
-literal "." or "..". So the mapping looks like this:
-
- Mac URI
- ---------- -------------------
- :foo:bar <==> foo/bar
- : <==> ./
- ::foo:bar <==> ../foo/bar
- ::: <==> ../../
- foo:bar <==> file:/foo/bar
- foo:bar: <==> file:/foo/bar/
- .. <==> %2E%2E
- <undef> <== /
- foo/ <== file:/foo%2F
- ./foo.txt <== file:/.%2Ffoo.txt
-
-Note that if you want a relative URL, you *must* begin the path with a :. Any
-path that begins with [^:] is treated as absolute.
-
-Example 2: The UNIX file system is easy to map, as it uses the same path
-separator as URIs, has a single root, and segments of "." and ".."
-have the same meaning. URIs that have the character "\0" or "/" as
-part of any path segment can not be turned into valid UNIX file names.
-
- UNIX URI
- ---------- ------------------
- foo/bar <==> foo/bar
- /foo/bar <==> file:/foo/bar
- /foo/bar <== file://localhost/foo/bar
- file: ==> ./file:
- <undef> <== file:/fo%00/bar
- / <==> file:/
-
-=cut
-
-
-RFC 1630
-
- [...]
-
- There is clearly a danger of confusion that a link made to a local
- file should be followed by someone on a different system, with
- unexpected and possibly harmful results. Therefore, the convention
- is that even a "file" URL is provided with a host part. This allows
- a client on another system to know that it cannot access the file
- system, or perhaps to use some other local mechanism to access the
- file.
-
- The special value "localhost" is used in the host field to indicate
- that the filename should really be used on whatever host one is.
- This for example allows links to be made to files which are
- distributed on many machines, or to "your unix local password file"
- subject of course to consistency across the users of the data.
-
- A void host field is equivalent to "localhost".
-
-=head1 CONFIGURATION VARIABLES
-
-The following configuration variables influence how the class and its
-methods behave:
-
-=over
-
-=item %URI::file::OS_CLASS
-
-This hash maps OS identifiers to implementation classes. You might
-want to add or modify this if you want to plug in your own file
-handler class. Normally the keys should match the $^O values in use.
-
-If there is no mapping then the "Unix" implementation is used.
-
-=item $URI::file::DEFAULT_AUTHORITY
-
-This determine what "authority" string to include in absolute file
-URIs. It defaults to "". If you prefer verbose URIs you might set it
-to be "localhost".
-
-Setting this value to C<undef> force behaviour compatible to URI v1.31
-and earlier. In this mode host names in UNC paths and drive letters
-are mapped to the authority component on Windows, while we produce
-authority-less URIs on Unix.
-
-=back
-
-
-=head1 SEE ALSO
-
-L<URI>, L<File::Spec>, L<perlport>
-
-=head1 COPYRIGHT
-
-Copyright 1995-1998,2004 Gisle Aas.
-
-This library is free software; you can redistribute it and/or
-modify it under the same terms as Perl itself.
-
-=cut
diff --git a/Master/tlpkg/tlperl/lib/URI/file/Base.pm b/Master/tlpkg/tlperl/lib/URI/file/Base.pm
deleted file mode 100755
index 941793b0f93..00000000000
--- a/Master/tlpkg/tlperl/lib/URI/file/Base.pm
+++ /dev/null
@@ -1,80 +0,0 @@
-package URI::file::Base;
-
-use strict;
-use URI::Escape qw();
-
-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; # class
- 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;
diff --git a/Master/tlpkg/tlperl/lib/URI/file/FAT.pm b/Master/tlpkg/tlperl/lib/URI/file/FAT.pm
deleted file mode 100755
index 328169bd0bf..00000000000
--- a/Master/tlpkg/tlperl/lib/URI/file/FAT.pm
+++ /dev/null
@@ -1,23 +0,0 @@
-package URI::file::FAT;
-
-require URI::file::Win32;
-@ISA=qw(URI::file::Win32);
-
-sub fix_path
-{
- shift; # class
- for (@_) {
- # turn it into 8.3 names
- my @p = map uc, split(/\./, $_, -1);
- return if @p > 2; # more than 1 dot is not allowed
- @p = ("") unless @p; # split bug? (returns nothing when splitting "")
- $_ = substr($p[0], 0, 8);
- if (@p > 1) {
- my $ext = substr($p[1], 0, 3);
- $_ .= ".$ext" if length $ext;
- }
- }
- 1; # ok
-}
-
-1;
diff --git a/Master/tlpkg/tlperl/lib/URI/file/Mac.pm b/Master/tlpkg/tlperl/lib/URI/file/Mac.pm
deleted file mode 100755
index 6cfa78192e0..00000000000
--- a/Master/tlpkg/tlperl/lib/URI/file/Mac.pm
+++ /dev/null
@@ -1,120 +0,0 @@
-package URI::file::Mac;
-
-require URI::file::Base;
-@ISA=qw(URI::file::Base);
-
-use strict;
-use URI::Escape qw(uri_unescape);
-
-
-
-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 { #absolute
- $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)) {
- # some other host (use it as volume name)
- @path = ("", $auth);
- # XXX or just return to make it illegal;
- }
- }
- }
- my @ps = split("/", $uri->path, -1);
- shift @ps if @path;
- push(@path, @ps);
-
- my $pre = "";
- if (!@path) {
- return; # empty path; XXX return ":" instead?
- } elsif ($path[0] eq "") {
- # absolute
- shift(@path);
- if (@path == 1) {
- return if $path[0] eq ""; # not root directory
- push(@path, ""); # volume only, effectively append ":"
- }
- @ps = @path;
- @path = ();
- my $part;
- for (@ps) { #fix up "." and "..", including interior, in relatives
- next if $_ eq ".";
- $part = $_ eq ".." ? "" : $_;
- push(@path,$part);
- }
- if ($ps[-1] eq "..") { #if this happens, we need another :
- push(@path,"");
- }
-
- } else {
- $pre = ":";
- @ps = @path;
- @path = ();
- my $part;
- for (@ps) { #fix up "." and "..", including interior, in relatives
- next if $_ eq ".";
- $part = $_ eq ".." ? "" : $_;
- push(@path,$part);
- }
- if ($ps[-1] eq "..") { #if this happens, we need another :
- push(@path,"");
- }
-
- }
- return unless $pre || @path;
- for (@path) {
- s/;.*//; # get rid of parameters
- #return unless length; # XXX
- $_ = uri_unescape($_);
- return if /\0/;
- return if /:/; # Should we?
- }
- $pre . join(":", @path);
-}
-
-sub dir
-{
- my $class = shift;
- my $path = $class->file(@_);
- return unless defined $path;
- $path .= ":" unless $path =~ /:$/;
- $path;
-}
-
-1;
diff --git a/Master/tlpkg/tlperl/lib/URI/file/OS2.pm b/Master/tlpkg/tlperl/lib/URI/file/OS2.pm
deleted file mode 100755
index ad0a78ede52..00000000000
--- a/Master/tlpkg/tlperl/lib/URI/file/OS2.pm
+++ /dev/null
@@ -1,28 +0,0 @@
-package URI::file::OS2;
-
-require URI::file::Win32;
-@ISA=qw(URI::file::Win32);
-
-# The Win32 version translates k:/foo to file://k:/foo (?!)
-# We add an empty host
-
-sub _file_extract_authority
-{
- my $class = shift;
- return $1 if $_[0] =~ s,^\\\\([^\\]+),,; # UNC
- return $1 if $_[0] =~ s,^//([^/]+),,; # UNC too?
-
- if ($_[0] =~ m#^[a-zA-Z]{1,2}:#) { # allow for ab: drives
- return "";
- }
- return;
-}
-
-sub file {
- my $p = &URI::file::Win32::file;
- return unless defined $p;
- $p =~ s,\\,/,g;
- $p;
-}
-
-1;
diff --git a/Master/tlpkg/tlperl/lib/URI/file/QNX.pm b/Master/tlpkg/tlperl/lib/URI/file/QNX.pm
deleted file mode 100755
index 93a4983d2bb..00000000000
--- a/Master/tlpkg/tlperl/lib/URI/file/QNX.pm
+++ /dev/null
@@ -1,18 +0,0 @@
-package URI::file::QNX;
-
-require URI::file::Unix;
-@ISA=qw(URI::file::Unix);
-
-use strict;
-
-sub _file_extract_path
-{
- my($class, $path) = @_;
- # tidy path
- $path =~ s,(.)//+,$1/,g; # ^// is correct
- $path =~ s,(/\.)+/,/,g;
- $path = "./$path" if $path =~ m,^[^:/]+:,,; # look like "scheme:"
- $path;
-}
-
-1;
diff --git a/Master/tlpkg/tlperl/lib/URI/file/Unix.pm b/Master/tlpkg/tlperl/lib/URI/file/Unix.pm
deleted file mode 100755
index 5f8aaae9050..00000000000
--- a/Master/tlpkg/tlperl/lib/URI/file/Unix.pm
+++ /dev/null
@@ -1,55 +0,0 @@
-package URI::file::Unix;
-
-require URI::file::Base;
-@ISA=qw(URI::file::Base);
-
-use strict;
-use URI::Escape qw(uri_unescape);
-
-sub _file_extract_path
-{
- my($class, $path) = @_;
-
- # tidy path
- $path =~ s,//+,/,g;
- $path =~ s,(/\.)+/,/,g;
- $path = "./$path" if $path =~ m,^[^:/]+:,,; # look like "scheme:"
-
- 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) {
- # Unix file/directory names are not allowed to contain '\0' or '/'
- return undef if /\0/;
- return undef if /\//; # should we really?
- }
-
- return join("/", @path);
-}
-
-1;
diff --git a/Master/tlpkg/tlperl/lib/URI/file/Win32.pm b/Master/tlpkg/tlperl/lib/URI/file/Win32.pm
deleted file mode 100755
index 04593863a92..00000000000
--- a/Master/tlpkg/tlperl/lib/URI/file/Win32.pm
+++ /dev/null
@@ -1,84 +0,0 @@
-package URI::file::Win32;
-
-require URI::file::Base;
-@ISA=qw(URI::file::Base);
-
-use strict;
-use URI::Escape qw(uri_unescape);
-
-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,^\\\\([^\\]+),,; # UNC
- return $1 if $_[0] =~ s,^//([^/]+),,; # UNC too?
-
- 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;
- $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; # is filename relative to drive specified in authority
- 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; # UNC
- }
- } else {
- $auth = "";
- }
-
- my @path = $uri->path_segments;
- for (@path) {
- return undef if /\0/;
- return undef if /\//;
- #return undef if /\\/; # URLs with "\" is not uncommon
- }
- 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;
diff --git a/Master/tlpkg/tlperl/lib/URI/ftp.pm b/Master/tlpkg/tlperl/lib/URI/ftp.pm
deleted file mode 100755
index 89aeb07cdc9..00000000000
--- a/Master/tlpkg/tlperl/lib/URI/ftp.pm
+++ /dev/null
@@ -1,45 +0,0 @@
-package URI::ftp;
-
-require URI::_server;
-require URI::_userpass;
-@ISA=qw(URI::_server URI::_userpass);
-
-use strict;
-
-sub default_port { 21 }
-
-sub path { shift->path_query(@_) } # XXX
-
-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') {
- # anonymous ftp login password
- # If there is no ftp anonymous password specified
- # then we'll just use 'anonymous@'
- # We don't try to send the read e-mail address because:
- # - We want to remain anonymous
- # - We want to stop SPAM
- # - We don't want to let ftp sites to discriminate by the user,
- # host, country or ftp client being used.
- $pass = 'anonymous@';
- }
- }
- $pass;
-}
-
-1;
diff --git a/Master/tlpkg/tlperl/lib/URI/gopher.pm b/Master/tlpkg/tlperl/lib/URI/gopher.pm
deleted file mode 100755
index ae6690423bc..00000000000
--- a/Master/tlpkg/tlperl/lib/URI/gopher.pm
+++ /dev/null
@@ -1,94 +0,0 @@
-package URI::gopher; # <draft-murali-url-gopher>, Dec 4, 1996
-
-require URI::_server;
-@ISA=qw(URI::_server);
-
-use strict;
-use URI::Escape qw(uri_unescape);
-
-# A Gopher URL follows the common internet scheme syntax as defined in
-# section 4.3 of [RFC-URL-SYNTAX]:
-#
-# gopher://<host>[:<port>]/<gopher-path>
-#
-# where
-#
-# <gopher-path> := <gopher-type><selector> |
-# <gopher-type><selector>%09<search> |
-# <gopher-type><selector>%09<search>%09<gopher+_string>
-#
-# <gopher-type> := '0' | '1' | '2' | '3' | '4' | '5' | '6' | '7'
-# '8' | '9' | '+' | 'I' | 'g' | 'T'
-#
-# <selector> := *pchar Refer to RFC 1808 [4]
-# <search> := *pchar
-# <gopher+_string> := *uchar Refer to RFC 1738 [3]
-#
-# If the optional port is omitted, the port defaults to 70.
-
-sub default_port { 70 }
-
-sub _gopher_type
-{
- my $self = shift;
- my $path = $self->path_query;
- $path =~ s,^/,,;
- my $gtype = $1 if $path =~ s/^(.)//s;
- if (@_) {
- my $new_type = shift;
- if (defined($new_type)) {
- Carp::croak("Bad gopher type '$new_type'")
- unless length($new_type) == 1;
- substr($path, 0, 0) = $new_type;
- $self->path_query($path);
- } else {
- Carp::croak("Can't delete gopher type when selector is present")
- if length($path);
- $self->path_query(undef);
- }
- }
- return $gtype;
-}
-
-sub gopher_type
-{
- my $self = shift;
- my $gtype = $self->_gopher_type(@_);
- $gtype = "1" unless defined $gtype;
- $gtype;
-}
-
-*gtype = \&gopher_type; # URI::URL compatibility
-
-sub selector { shift->_gfield(0, @_) }
-sub search { shift->_gfield(1, @_) }
-sub string { shift->_gfield(2, @_) }
-
-sub _gfield
-{
- my $self = shift;
- my $fno = shift;
- my $path = $self->path_query;
-
- # not according to spec., but many popular browsers accept
- # gopher URLs with a '?' before the search string.
- $path =~ s/\?/\t/;
- $path = uri_unescape($path);
- $path =~ s,^/,,;
- my $gtype = $1 if $path =~ s,^(.),,s;
- my @path = split(/\t/, $path, 3);
- if (@_) {
- # modify
- my $new = shift;
- $path[$fno] = $new;
- pop(@path) while @path && !defined($path[-1]);
- for (@path) { $_="" unless defined }
- $path = $gtype;
- $path = "1" unless defined $path;
- $path .= join("\t", @path);
- $self->path_query($path);
- }
- $path[$fno];
-}
-
-1;
diff --git a/Master/tlpkg/tlperl/lib/URI/http.pm b/Master/tlpkg/tlperl/lib/URI/http.pm
deleted file mode 100755
index cb698224060..00000000000
--- a/Master/tlpkg/tlperl/lib/URI/http.pm
+++ /dev/null
@@ -1,25 +0,0 @@
-package URI::http;
-
-require URI::_server;
-@ISA=qw(URI::_server);
-
-use strict;
-
-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;
diff --git a/Master/tlpkg/tlperl/lib/URI/https.pm b/Master/tlpkg/tlperl/lib/URI/https.pm
deleted file mode 100755
index c39c67b5ec3..00000000000
--- a/Master/tlpkg/tlperl/lib/URI/https.pm
+++ /dev/null
@@ -1,7 +0,0 @@
-package URI::https;
-require URI::http;
-@ISA=qw(URI::http);
-
-sub default_port { 443 }
-
-1;
diff --git a/Master/tlpkg/tlperl/lib/URI/ldap.pm b/Master/tlpkg/tlperl/lib/URI/ldap.pm
deleted file mode 100755
index 8af504b269d..00000000000
--- a/Master/tlpkg/tlperl/lib/URI/ldap.pm
+++ /dev/null
@@ -1,122 +0,0 @@
-# Copyright (c) 1998 Graham Barr <gbarr@pobox.com>. All rights reserved.
-# This program is free software; you can redistribute it and/or
-# modify it under the same terms as Perl itself.
-
-package URI::ldap;
-
-use strict;
-
-use vars qw(@ISA $VERSION);
-$VERSION = "1.11";
-
-require URI::_server;
-require URI::_ldap;
-@ISA=qw(URI::_ldap URI::_server);
-
-sub default_port { 389 }
-
-sub _nonldap_canonical {
- my $self = shift;
- $self->URI::_server::canonical(@_);
-}
-
-1;
-
-__END__
-
-=head1 NAME
-
-URI::ldap - LDAP Uniform Resource Locators
-
-=head1 SYNOPSIS
-
- use URI;
-
- $uri = URI->new("ldap:$uri_string");
- $dn = $uri->dn;
- $filter = $uri->filter;
- @attr = $uri->attributes;
- $scope = $uri->scope;
- %extn = $uri->extensions;
-
- $uri = URI->new("ldap:"); # start empty
- $uri->host("ldap.itd.umich.edu");
- $uri->dn("o=University of Michigan,c=US");
- $uri->attributes(qw(postalAddress));
- $uri->scope('sub');
- $uri->filter('(cn=Babs Jensen)');
- print $uri->as_string,"\n";
-
-=head1 DESCRIPTION
-
-C<URI::ldap> provides an interface to parse an LDAP URI into its
-constituent parts and also to build a URI as described in
-RFC 2255.
-
-=head1 METHODS
-
-C<URI::ldap> supports all the generic and server methods defined by
-L<URI>, plus the following.
-
-Each of the following methods can be used to set or get the value in
-the URI. The values are passed in unescaped form. None of these
-return undefined values, but elements without a default can be empty.
-If arguments are given, then a new value is set for the given part
-of the URI.
-
-=over 4
-
-=item $uri->dn( [$new_dn] )
-
-Sets or gets the I<Distinguished Name> part of the URI. The DN
-identifies the base object of the LDAP search.
-
-=item $uri->attributes( [@new_attrs] )
-
-Sets or gets the list of attribute names which are
-returned by the search.
-
-=item $uri->scope( [$new_scope] )
-
-Sets or gets the scope to be used by the search. The value can be one of
-C<"base">, C<"one"> or C<"sub">. If none is given in the URI then the
-return value defaults to C<"base">.
-
-=item $uri->_scope( [$new_scope] )
-
-Same as scope(), but does not default to anything.
-
-=item $uri->filter( [$new_filter] )
-
-Sets or gets the filter to be used by the search. If none is given in
-the URI then the return value defaults to C<"(objectClass=*)">.
-
-=item $uri->_filter( [$new_filter] )
-
-Same as filter(), but does not default to anything.
-
-=item $uri->extensions( [$etype => $evalue,...] )
-
-Sets or gets the extensions used for the search. The list passed should
-be in the form etype1 => evalue1, etype2 => evalue2,... This is also
-the form of list that is returned.
-
-=back
-
-=head1 SEE ALSO
-
-L<RFC-2255|http://www.cis.ohio-state.edu/htbin/rfc/rfc2255.html>
-
-=head1 AUTHOR
-
-Graham Barr E<lt>F<gbarr@pobox.com>E<gt>
-
-Slightly modified by Gisle Aas to fit into the URI distribution.
-
-=head1 COPYRIGHT
-
-Copyright (c) 1998 Graham Barr. All rights reserved. This program is
-free software; you can redistribute it and/or modify it under the same
-terms as Perl itself.
-
-=cut
diff --git a/Master/tlpkg/tlperl/lib/URI/ldapi.pm b/Master/tlpkg/tlperl/lib/URI/ldapi.pm
deleted file mode 100755
index d92b13f3a49..00000000000
--- a/Master/tlpkg/tlperl/lib/URI/ldapi.pm
+++ /dev/null
@@ -1,30 +0,0 @@
-package URI::ldapi;
-
-use strict;
-
-use vars qw(@ISA);
-
-require URI::_generic;
-require URI::_ldap;
-@ISA=qw(URI::_ldap URI::_generic);
-
-require 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;
diff --git a/Master/tlpkg/tlperl/lib/URI/ldaps.pm b/Master/tlpkg/tlperl/lib/URI/ldaps.pm
deleted file mode 100755
index 20180d55773..00000000000
--- a/Master/tlpkg/tlperl/lib/URI/ldaps.pm
+++ /dev/null
@@ -1,7 +0,0 @@
-package URI::ldaps;
-require URI::ldap;
-@ISA=qw(URI::ldap);
-
-sub default_port { 636 }
-
-1;
diff --git a/Master/tlpkg/tlperl/lib/URI/mailto.pm b/Master/tlpkg/tlperl/lib/URI/mailto.pm
deleted file mode 100755
index 88761c40333..00000000000
--- a/Master/tlpkg/tlperl/lib/URI/mailto.pm
+++ /dev/null
@@ -1,72 +0,0 @@
-package URI::mailto; # RFC 2368
-
-require URI;
-require URI::_query;
-@ISA=qw(URI URI::_query);
-
-use strict;
-
-sub to
-{
- my $self = shift;
- my @old = $self->headers;
- if (@_) {
- my @new = @old;
- # get rid of any other to: fields
- 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;
-
- # The trick is to just treat everything as the query string...
- my $opaque = "to=" . $self->opaque;
- $opaque =~ s/\?/&/;
-
- if (@_) {
- my @new = @_;
-
- # strip out any "to" fields
- my @to;
- for (my $i=0; $i < @new; $i += 2) {
- if (lc($new[$i] || '') eq "to") {
- push(@to, (splice(@new, $i, 2))[1]); # remove header
- 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;
-
- # I am lazy today...
- URI->new("mailto:?$opaque")->query_form;
-}
-
-1;
diff --git a/Master/tlpkg/tlperl/lib/URI/mms.pm b/Master/tlpkg/tlperl/lib/URI/mms.pm
deleted file mode 100755
index 2f1015b61d9..00000000000
--- a/Master/tlpkg/tlperl/lib/URI/mms.pm
+++ /dev/null
@@ -1,8 +0,0 @@
-package URI::mms;
-
-require URI::http;
-@ISA=qw(URI::http);
-
-sub default_port { 1755 }
-
-1;
diff --git a/Master/tlpkg/tlperl/lib/URI/news.pm b/Master/tlpkg/tlperl/lib/URI/news.pm
deleted file mode 100755
index 1ffb419f673..00000000000
--- a/Master/tlpkg/tlperl/lib/URI/news.pm
+++ /dev/null
@@ -1,68 +0,0 @@
-package URI::news; # draft-gilman-news-url-01
-
-require URI::_server;
-@ISA=qw(URI::_server);
-
-use strict;
-use URI::Escape qw(uri_unescape);
-use Carp ();
-
-sub default_port { 119 }
-
-# newsURL = scheme ":" [ news-server ] [ refbygroup | message ]
-# scheme = "news" | "snews" | "nntp"
-# news-server = "//" server "/"
-# refbygroup = group [ "/" messageno [ "-" messageno ] ]
-# message = local-part "@" domain
-
-sub _group
-{
- my $self = shift;
- my $old = $self->path;
- if (@_) {
- my($group,$from,$to) = @_;
- if ($group =~ /\@/) {
- $group =~ s/^<(.*)>$/$1/; # "<" and ">" should not be part of it
- }
- $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 unless $old =~ /\@/;
- return $old;
-}
-
-1;
diff --git a/Master/tlpkg/tlperl/lib/URI/nntp.pm b/Master/tlpkg/tlperl/lib/URI/nntp.pm
deleted file mode 100755
index af61e036cc7..00000000000
--- a/Master/tlpkg/tlperl/lib/URI/nntp.pm
+++ /dev/null
@@ -1,6 +0,0 @@
-package URI::nntp; # draft-gilman-news-url-01
-
-require URI::news;
-@ISA=qw(URI::news);
-
-1;
diff --git a/Master/tlpkg/tlperl/lib/URI/pop.pm b/Master/tlpkg/tlperl/lib/URI/pop.pm
deleted file mode 100755
index 50b8d6dd511..00000000000
--- a/Master/tlpkg/tlperl/lib/URI/pop.pm
+++ /dev/null
@@ -1,68 +0,0 @@
-package URI::pop; # RFC 2384
-
-require URI::_server;
-@ISA=qw(URI::_server);
-
-use strict;
-use URI::Escape qw(uri_unescape);
-
-sub default_port { 110 }
-
-#pop://<user>;auth=<auth>@<host>:<port>
-
-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 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 unless defined $old;
- $old =~ s/^[^;]*//;
- return uri_unescape($1) if $old =~ /;auth=(.*)/i;
- return;
-}
-
-1;
diff --git a/Master/tlpkg/tlperl/lib/URI/rlogin.pm b/Master/tlpkg/tlperl/lib/URI/rlogin.pm
deleted file mode 100755
index 18bb76272a4..00000000000
--- a/Master/tlpkg/tlperl/lib/URI/rlogin.pm
+++ /dev/null
@@ -1,7 +0,0 @@
-package URI::rlogin;
-require URI::_login;
-@ISA = qw(URI::_login);
-
-sub default_port { 513 }
-
-1;
diff --git a/Master/tlpkg/tlperl/lib/URI/rsync.pm b/Master/tlpkg/tlperl/lib/URI/rsync.pm
deleted file mode 100755
index 160d9d0c065..00000000000
--- a/Master/tlpkg/tlperl/lib/URI/rsync.pm
+++ /dev/null
@@ -1,12 +0,0 @@
-package URI::rsync; # http://rsync.samba.org/
-
-# rsync://[USER@]HOST[:PORT]/SRC
-
-require URI::_server;
-require URI::_userpass;
-
-@ISA=qw(URI::_server URI::_userpass);
-
-sub default_port { 873 }
-
-1;
diff --git a/Master/tlpkg/tlperl/lib/URI/rtsp.pm b/Master/tlpkg/tlperl/lib/URI/rtsp.pm
deleted file mode 100755
index 982ca5ebf1e..00000000000
--- a/Master/tlpkg/tlperl/lib/URI/rtsp.pm
+++ /dev/null
@@ -1,8 +0,0 @@
-package URI::rtsp;
-
-require URI::http;
-@ISA=qw(URI::http);
-
-sub default_port { 554 }
-
-1;
diff --git a/Master/tlpkg/tlperl/lib/URI/rtspu.pm b/Master/tlpkg/tlperl/lib/URI/rtspu.pm
deleted file mode 100755
index dbcf12bb2f4..00000000000
--- a/Master/tlpkg/tlperl/lib/URI/rtspu.pm
+++ /dev/null
@@ -1,8 +0,0 @@
-package URI::rtspu;
-
-require URI::rtsp;
-@ISA=qw(URI::rtsp);
-
-sub default_port { 554 }
-
-1;
diff --git a/Master/tlpkg/tlperl/lib/URI/sip.pm b/Master/tlpkg/tlperl/lib/URI/sip.pm
deleted file mode 100755
index 1ace52c4f58..00000000000
--- a/Master/tlpkg/tlperl/lib/URI/sip.pm
+++ /dev/null
@@ -1,86 +0,0 @@
-#
-# Written by Ryan Kereliuk <ryker@ryker.org>. This file may be
-# distributed under the same terms as Perl itself.
-#
-# The RFC 3261 sip URI is <scheme>:<authority>;<params>?<query>.
-#
-
-package URI::sip;
-
-require URI::_server;
-require URI::_userpass;
-@ISA=qw(URI::_server URI::_userpass);
-
-use strict;
-use vars qw(@ISA $VERSION);
-use URI::Escape qw(uri_unescape);
-
-$VERSION = "0.10";
-
-sub default_port { 5060 }
-
-sub authority
-{
- my $self = shift;
- $$self =~ m,^($URI::scheme_re:)?([^;?]*)(.*)$,os or die;
- my $old = $2;
-
- if (@_) {
- my $auth = shift;
- $$self = defined($1) ? $1 : "";
- my $rest = $3;
- if (defined $auth) {
- $auth =~ s/([^$URI::uric])/ URI::Escape::escape_char($1)/ego;
- $$self .= "$auth";
- }
- $$self .= $rest;
- }
- $old;
-}
-
-sub params_form
-{
- my $self = shift;
- $$self =~ m,^((?:$URI::scheme_re:)?)(?:([^;?]*))?(;[^?]*)?(.*)$,os or die;
- my $paramstr = $3;
-
- if (@_) {
- my @args = @_;
- $$self = $1 . $2;
- my $rest = $4;
- my @new;
- for (my $i=0; $i < @args; $i += 2) {
- push(@new, "$args[$i]=$args[$i+1]");
- }
- $paramstr = join(";", @new);
- $$self .= ";" . $paramstr . $rest;
- }
- $paramstr =~ s/^;//o;
- return split(/[;=]/, $paramstr);
-}
-
-sub params
-{
- my $self = shift;
- $$self =~ m,^((?:$URI::scheme_re:)?)(?:([^;?]*))?(;[^?]*)?(.*)$,os or die;
- my $paramstr = $3;
-
- if (@_) {
- my $new = shift;
- $$self = $1 . $2;
- my $rest = $4;
- $$self .= $paramstr . $rest;
- }
- $paramstr =~ s/^;//o;
- return $paramstr;
-}
-
-# Inherited methods that make no sense for a SIP URI.
-sub path {}
-sub path_query {}
-sub path_segments {}
-sub abs { shift }
-sub rel { shift }
-sub query_keywords {}
-
-1;
diff --git a/Master/tlpkg/tlperl/lib/URI/sips.pm b/Master/tlpkg/tlperl/lib/URI/sips.pm
deleted file mode 100755
index b32e105e24b..00000000000
--- a/Master/tlpkg/tlperl/lib/URI/sips.pm
+++ /dev/null
@@ -1,7 +0,0 @@
-package URI::sips;
-require URI::sip;
-@ISA=qw(URI::sip);
-
-sub default_port { 5061 }
-
-1;
diff --git a/Master/tlpkg/tlperl/lib/URI/snews.pm b/Master/tlpkg/tlperl/lib/URI/snews.pm
deleted file mode 100755
index 7e5b0379e15..00000000000
--- a/Master/tlpkg/tlperl/lib/URI/snews.pm
+++ /dev/null
@@ -1,8 +0,0 @@
-package URI::snews; # draft-gilman-news-url-01
-
-require URI::news;
-@ISA=qw(URI::news);
-
-sub default_port { 563 }
-
-1;
diff --git a/Master/tlpkg/tlperl/lib/URI/ssh.pm b/Master/tlpkg/tlperl/lib/URI/ssh.pm
deleted file mode 100755
index 5cd30fc3bfc..00000000000
--- a/Master/tlpkg/tlperl/lib/URI/ssh.pm
+++ /dev/null
@@ -1,9 +0,0 @@
-package URI::ssh;
-require URI::_login;
-@ISA=qw(URI::_login);
-
-# ssh://[USER@]HOST[:PORT]/SRC
-
-sub default_port { 22 }
-
-1;
diff --git a/Master/tlpkg/tlperl/lib/URI/telnet.pm b/Master/tlpkg/tlperl/lib/URI/telnet.pm
deleted file mode 100755
index 5f842d35787..00000000000
--- a/Master/tlpkg/tlperl/lib/URI/telnet.pm
+++ /dev/null
@@ -1,7 +0,0 @@
-package URI::telnet;
-require URI::_login;
-@ISA = qw(URI::_login);
-
-sub default_port { 23 }
-
-1;
diff --git a/Master/tlpkg/tlperl/lib/URI/tn3270.pm b/Master/tlpkg/tlperl/lib/URI/tn3270.pm
deleted file mode 100755
index dd1e648e713..00000000000
--- a/Master/tlpkg/tlperl/lib/URI/tn3270.pm
+++ /dev/null
@@ -1,7 +0,0 @@
-package URI::tn3270;
-require URI::_login;
-@ISA = qw(URI::_login);
-
-sub default_port { 23 }
-
-1;
diff --git a/Master/tlpkg/tlperl/lib/URI/urn.pm b/Master/tlpkg/tlperl/lib/URI/urn.pm
deleted file mode 100755
index 12d40b265bc..00000000000
--- a/Master/tlpkg/tlperl/lib/URI/urn.pm
+++ /dev/null
@@ -1,97 +0,0 @@
-package URI::urn; # RFC 2141
-
-require URI;
-@ISA=qw(URI);
-
-use strict;
-use Carp qw(carp);
-
-use vars qw(%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;
- # make it a legal perl identifier
- $id =~ s/-/_/g;
- $id = "_$id" if $id =~ /^\d/;
-
- $impclass = "URI::urn::$id";
- no strict 'refs';
- unless (@{"${impclass}::ISA"}) {
- # Try to load it
- eval "require $impclass";
- die $@ if $@ && $@ !~ /Can\'t locate.*in \@INC/;
- $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);
- # XXX possible rebless
- }
- $opaque =~ s/:.*//s;
- return $opaque;
-}
-
-sub nid { # namespace identifier
- my $self = shift;
- my $nid = $self->_nid(@_);
- $nid = lc($nid) if defined($nid);
- return $nid;
-}
-
-sub nss { # namespace specific string
- 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;
diff --git a/Master/tlpkg/tlperl/lib/URI/urn/isbn.pm b/Master/tlpkg/tlperl/lib/URI/urn/isbn.pm
deleted file mode 100755
index 0da931bfb69..00000000000
--- a/Master/tlpkg/tlperl/lib/URI/urn/isbn.pm
+++ /dev/null
@@ -1,102 +0,0 @@
-package URI::urn::isbn; # RFC 3187
-
-require URI::urn;
-@ISA=qw(URI::urn);
-
-use strict;
-use Carp qw(carp);
-
-BEGIN {
- require Business::ISBN;
-
- local $^W = 0; # don't warn about dev versions, perl5.004 style
- warn "Using Business::ISBN version " . Business::ISBN->VERSION .
- " which is deprecated.\nUpgrade to Business::ISBN version 2\n"
- if Business::ISBN->VERSION < 2;
- }
-
-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; # don't warn about dev versions, perl5.004 style
- 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; # don't warn about dev versions, perl5.004 style
- Business::ISBN->VERSION >= 2 ? 'as_isbn13' : 'as_ean';
- };
-
-sub isbn13 {
- my $isbn = shift->_isbn || return undef;
-
- # Business::ISBN 1.x didn't put hyphens in the EAN, and it was just a string
- # Business::ISBN 2.0 doesn't do EAN, but it does ISBN-13 objects
- # and it uses the hyphens, so call as_string with an empty anon array
- # or, adjust the test and features to say that it comes out with hyphens.
- 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;
diff --git a/Master/tlpkg/tlperl/lib/URI/urn/oid.pm b/Master/tlpkg/tlperl/lib/URI/urn/oid.pm
deleted file mode 100755
index 301b2bcd834..00000000000
--- a/Master/tlpkg/tlperl/lib/URI/urn/oid.pm
+++ /dev/null
@@ -1,18 +0,0 @@
-package URI::urn::oid; # RFC 2061
-
-require URI::urn;
-@ISA=qw(URI::urn);
-
-use strict;
-
-sub oid {
- my $self = shift;
- my $old = $self->nss;
- if (@_) {
- $self->nss(join(".", @_));
- }
- return split(/\./, $old) if wantarray;
- return $old;
-}
-
-1;