summaryrefslogtreecommitdiff
path: root/Master/tlpkg/tlperl/lib/URI/URL.pm
diff options
context:
space:
mode:
Diffstat (limited to 'Master/tlpkg/tlperl/lib/URI/URL.pm')
-rwxr-xr-xMaster/tlpkg/tlperl/lib/URI/URL.pm305
1 files changed, 0 insertions, 305 deletions
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