FM / URI

/usr/local/share/perl5/URI

Name	Size	Mode	Actions
file/	-	0755	rm
urn/	-	0755	rm
data.pm	3417	0444	edit dl rm
Escape.pm	7022	0444	edit dl rm
file.pm	9761	0444	edit dl rm
ftp.pm	1082	0444	edit dl rm
gopher.pm	2454	0444	edit dl rm
Heuristic.pm	6524	0444	edit dl rm
http.pm	451	0444	edit dl rm
https.pm	170	0444	edit dl rm
IRI.pm	820	0444	edit dl rm
ldap.pm	2950	0444	edit dl rm
ldapi.pm	467	0444	edit dl rm
ldaps.pm	170	0444	edit dl rm
mailto.pm	1302	0444	edit dl rm
mms.pm	151	0444	edit dl rm
news.pm	1480	0444	edit dl rm
nntp.pm	153	0444	edit dl rm
pop.pm	1233	0444	edit dl rm
QueryParam.pm	4887	0444	edit dl rm
rlogin.pm	155	0444	edit dl rm
rsync.pm	233	0444	edit dl rm
rtsp.pm	151	0444	edit dl rm
rtspu.pm	152	0444	edit dl rm
sftp.pm	124	0444	edit dl rm
sip.pm	1735	0444	edit dl rm
sips.pm	169	0444	edit dl rm
snews.pm	198	0444	edit dl rm
Split.pm	2379	0444	edit dl rm
ssh.pm	201	0444	edit dl rm
telnet.pm	154	0444	edit dl rm
tn3270.pm	154	0444	edit dl rm
URL.pm	5487	0444	edit dl rm
urn.pm	2201	0444	edit dl rm
WithBase.pm	3857	0444	edit dl rm
_foreign.pm	133	0444	edit dl rm
_generic.pm	5848	0444	edit dl rm
_idna.pm	2103	0444	edit dl rm
_ldap.pm	3275	0444	edit dl rm
_login.pm	257	0444	edit dl rm
_punycode.pm	4648	0444	edit dl rm
_query.pm	2557	0444	edit dl rm
_segment.pm	442	0444	edit dl rm
_server.pm	3750	0444	edit dl rm
_userpass.pm	1060	0444	edit dl rm

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

package URI::URL;

use strict;
use warnings;

use parent 'URI::WithBase';

our $VERSION = "5.04";

# 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: