FM / URI

/usr/share/perl5/URI

Name	Size	Mode	Actions
file/	-	0755	rm
urn/	-	0755	rm
data.pm	3390	0644	edit dl rm
Escape.pm	7061	0644	edit dl rm
file.pm	9761	0644	edit dl rm
ftp.pm	1056	0644	edit dl rm
gopher.pm	2428	0644	edit dl rm
Heuristic.pm	6527	0644	edit dl rm
http.pm	425	0644	edit dl rm
https.pm	144	0644	edit dl rm
IRI.pm	794	0644	edit dl rm
ldap.pm	2924	0644	edit dl rm
ldapi.pm	440	0644	edit dl rm
ldaps.pm	144	0644	edit dl rm
mailto.pm	1657	0644	edit dl rm
mms.pm	125	0644	edit dl rm
news.pm	1454	0644	edit dl rm
nntp.pm	127	0644	edit dl rm
nntps.pm	144	0644	edit dl rm
pop.pm	1207	0644	edit dl rm
QueryParam.pm	4861	0644	edit dl rm
rlogin.pm	129	0644	edit dl rm
rsync.pm	207	0644	edit dl rm
rtsp.pm	125	0644	edit dl rm
rtspu.pm	126	0644	edit dl rm
sftp.pm	98	0644	edit dl rm
sip.pm	1695	0644	edit dl rm
sips.pm	143	0644	edit dl rm
snews.pm	172	0644	edit dl rm
Split.pm	2353	0644	edit dl rm
ssh.pm	175	0644	edit dl rm
telnet.pm	128	0644	edit dl rm
tn3270.pm	128	0644	edit dl rm
URL.pm	5487	0644	edit dl rm
urn.pm	2175	0644	edit dl rm
WithBase.pm	3862	0644	edit dl rm
_foreign.pm	107	0644	edit dl rm
_generic.pm	5822	0644	edit dl rm
_idna.pm	2079	0644	edit dl rm
_ldap.pm	3249	0644	edit dl rm
_login.pm	231	0644	edit dl rm
_punycode.pm	5622	0644	edit dl rm
_query.pm	2531	0644	edit dl rm
_segment.pm	416	0644	edit dl rm
_server.pm	3724	0644	edit dl rm
_userpass.pm	1034	0644	edit dl rm

Edit: /usr/share/perl5/URI/URL.pm (5487B)

package URI::URL;

use strict;
use warnings;

use parent 'URI::WithBase';

our $VERSION = '5.10';

# Provide as much as possible of the old URI::URL interface for backwards
# compatibility...

use Exporter 5.57 'import';
our @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 undef unless ref($p[-1]);
    @p = @{$p[-1]};
    shift @p;
    join(";", @p);
}

sub params { shift->eparams(@_); }

sub path {
    my $self = shift;
    my $old = $self->epath(@_);
    return unless defined wantarray;
    return '/' if !defined($old) || !length($old);
    Carp::croak("Path components contain '/' (you must call epath)")
	if $old =~ /%2[fF]/ and !@_;
    $old = "/$old" if $old !~ m|^/| && defined $self->netloc;
    return uri_unescape($old);
}

sub path_components {
    shift->path_segments(@_);
}

sub query {
    my $self = shift;
    my $old = $self->equery(@_);
    if (defined(wantarray) && defined($old)) {
	if ($old =~ /%(?:26|2[bB]|3[dD])/) {  # 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 losing
	# 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(@_); }

__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

=cut

cmd: