tlperl 5.22.1 from siep

git-svn-id: svn://tug.org/texlive/trunk@40252 c570f23f-e606-0410-a88d-b1316a301751

1 files changed, 0 insertions, 254 deletions

diff --git a/Master/tlpkg/tlperl/lib/URI/_generic.pm b/Master/tlpkg/tlperl/lib/URI/_generic.pm
deleted file mode 100644
index ce1e03d882d..00000000000
--- a/Master/tlpkg/tlperl/lib/URI/_generic.pm
+++ /dev/null
@@ -1,254 +0,0 @@
-package URI::_generic;
-
-use strict;
-use warnings;
-
-use parent qw(URI URI::_query);
-
-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;
-	    utf8::downgrade($auth);
-	    $$self .= "//$auth";
-	}
-	_check_path($rest, $$self);
-	$$self .= $rest;
-    }
-    $2;
-}
-
-sub path
-{
-    my $self = shift;
-    $$self =~ m,^((?:[^:/?\#]+:)?(?://[^/?\#]*)?)([^?\#]*)(.*)$,s or die;
-
-    if (@_) {
-	$$self = $1;
-	my $rest = $3;
-	my $new_path = shift;
-	$new_path = "" unless defined $new_path;
-	$new_path =~ s/([^$PCHAR])/ URI::Escape::escape_char($1)/ego;
-	utf8::downgrade($new_path);
-	_check_path($new_path, $$self);
-	$$self .= $new_path . $rest;
-    }
-    $2;
-}
-
-sub path_query
-{
-    my $self = shift;
-    $$self =~ m,^((?:[^:/?\#]+:)?(?://[^/?\#]*)?)([^\#]*)(.*)$,s or die;
-
-    if (@_) {
-	$$self = $1;
-	my $rest = $3;
-	my $new_path = shift;
-	$new_path = "" unless defined $new_path;
-	$new_path =~ s/([^$URI::uric])/ URI::Escape::escape_char($1)/ego;
-	utf8::downgrade($new_path);
-	_check_path($new_path, $$self);
-	$$self .= $new_path . $rest;
-    }
-    $2;
-}
-
-sub _check_path
-{
-    my($path, $pre) = @_;
-    my $prefix;
-    if ($pre =~ m,/,) {  # 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;
-	my $fragment = $self->fragment;
-	$abs->fragment($fragment) if defined $fragment;
-	return $abs;
-    }
-
-    my $p = $base->path;
-    $p =~ s,[^/]+$,,;
-    $p .= $path;
-    my @p = split('/', $p, -1);
-    shift(@p) if @p && !length($p[0]);
-    my $i = 1;
-    while ($i < @p) {
-	#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 opposite 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;