URI::PathAbstract - A URI-like object with Path::Abstract capabilities

URI-PathAbstract documentation Contained in the URI-PathAbstract distribution.

Index

Code Index:

NAME

Top

URI::PathAbstract - A URI-like object with Path::Abstract capabilities

VERSION

Top

Version 0.01

SYNOPSIS

Top

    my $uri = URI::PathAbstract->new("http://example.com?a=b")

    $uri->down("apple")
    # http://example.com/apple?a=b

    $uri->query("c=d&e=f")
    # http://example.com/apple?c=d&e=f

    $uri->path("grape/blueberry/pineapple")
    # http://example.com/grape/blueberry/pineapple?c=d&e=f

    $uri = $uri->parent
    # http://example.com/grape/blueberry?c=d&e=f

    $uri = $uri->child("xyzzy")
    # http://example.com/grape/blueberry/xyzzy?c=d&e=f

DESCRIPTION

Top

URI::PathAbstract is a combination of the URI::WithBase and Path::Abstract classes. It is essentially a URI class that delegates path-handling methods to Path::Abstract

Unfortunately, this is not true:

    URI::PathAbstract->new( http://example.com )->isa( URI )

URI::PathAbstract supports the URI generic and common methods

METHODS

Top

URI::PathAbstract->new( <uri>, ... )

Create a new URI::PathAbstract object based on <uri>

<uri> should be of the URI class or some sort of URI-like string

URI::PathAbstract->new( <uri>, path => <path>, ... )

Create a new URI::PathAbstract object based on <uri> but overriding the path with <path>

    URI::PathAbstract->new("http://example.com/cherry?a=b", path => "grape/lemon")
    # http://example.com/grape/lemon?a=b"

URI::PathAbstract->new( <uri>, child => <child>, ... )

Create a new URI::PathAbstract object based on <uri> but modifying the path by <child>

    URI::PathAbstract->new("http://example.com/cherry?a=b", child => "grape/lemon")
    # http://example.com/cherry/grape/lemon?a=b"

URI::PathAbstract->new( ... )

Create a new URI::PathAbstract object based on the following:

    uri         The URI you want to represent

    base        A base URI for use with ->abs and ->rel

    path        A path that will override the path of the given uri
                (although the scheme, host, ... will remain the same)

    child       A path that will be appended to the path of the given uri

$uri->uri

Returns a URI object that is a copy (not a reference) of the URI object inside $uri

$uri->path

Returns a Path::Abstract object that is a copy (not a reference) of the Path::Abstract object inside $uri

$uri->path( <path> )

Sets the path of $uri, completely overwriting what was there before

The rest of $uri (host, port, scheme, query, ...) does not change

$uri->clone

Returns a URI::PathAbstract that is an exact clone of $uri

$uri->base

Returns a URI::PathAbstract object that is a copy (not a reference) of the base for $uri

Returns undef if $uri does not have a base uri

$uri->base( <base> )

Sets the base of $uri to <base>

$uri->abs

$uri->abs( [ <base> ] )

Returns a URI::PathAbstract object that is the absolute URI formed by combining $uri and <base>

If <base> is not given, then $uri->base is used as the base

If <base> is not given and $uri->base does not exist, then a clone of $uri is returned

See URI and URI::WithBase for more abs information

$uri->rel

$uri->rel( [ <base> ] )

Returns a URI::PathAbstract object that is the relative URI formed by comparing $uri and <base>

If <base> is not given, then $uri->base is used as the base

If <base> is not given and $uri->base does not exist, then a clone of $uri is returned

See URI and URI::WithBase for more rel information

URI

See URI for more information

->scheme

->fragment

->as_string

->canonical

->eq

->authority

->query

->query_form

->query_keywords

->userinfo

->host

->port

->host_port

->default_port

->opaque

->path_query

->path_segments

Path::Abstract

See Path::Abstract for more information

->child

->parent

->up

->pop

->down

->push

->to_tree

->to_branch

->list

->first

->last

->is_empty

->is_nil

->is_root

->is_tree

->is_branch

SEE ALSO

Top

URI

URI::WithBase

Path::Abstract

Path::Resource

URI::SmartURI

AUTHOR

Top

Robert Krimen, <rkrimen at cpan.org>

SOURCE

Top

You can contribute or fork this project via GitHub:

http://github.com/robertkrimen/uri-pathabstract/tree/master

    git clone git://github.com/robertkrimen/uri-pathabstract.git URI-PathAbstract

BUGS

Top

Please report any bugs or feature requests to bug-uri-pathabstract at rt.cpan.org, or through the web interface at http://rt.cpan.org/NoAuth/ReportBug.html?Queue=URI-PathAbstract. I will be notified, and then you'll automatically be notified of progress on your bug as I make changes.

SUPPORT

Top

You can find documentation for this module with the perldoc command.

    perldoc URI::PathAbstract

You can also look for information at:

* RT: CPAN's request tracker

http://rt.cpan.org/NoAuth/Bugs.html?Dist=URI-PathAbstract

* AnnoCPAN: Annotated CPAN documentation

http://annocpan.org/dist/URI-PathAbstract

* CPAN Ratings

http://cpanratings.perl.org/d/URI-PathAbstract

* Search CPAN

http://search.cpan.org/dist/URI-PathAbstract

ACKNOWLEDGEMENTS

Top

COPYRIGHT & LICENSE

Top

Copyright 2008 Robert Krimen, all rights reserved.

This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.

URI-PathAbstract documentation Contained in the URI-PathAbstract distribution. 
package URI::PathAbstract;

use strict;
use warnings;


our $VERSION = '0.01';


use URI;
use Path::Abstract;
use Scalar::Util qw/blessed/;
use Carp;

use overload
    '""' => sub { $_[0]->{uri}->as_string },
    '==' => sub { overload::StrVal($_[0]) eq overload::StrVal($_[1]) },
    fallback => 1,
;


sub new {
    my $self = bless {}, shift;

    my %given;
    if (@_ == 1 ) {
        $self->uri(shift);
    }
    elsif (@_ % 2) {
        $self->uri(shift);
        %given = @_;
    }
    elsif (@_) {
        %given = @_;
        $self->uri(delete $given{uri});
    }
    else {
        $self->uri(URI->new);
    }

    if (%given) {
        $self->path($given{path}) if defined $given{path};
        $self->down($given{child}) if defined $given{child};
        $self->base($given{base}) if defined $given{base};
    }

    return $self;
}


sub uri {
    my $self = shift;
    if (@_) {
        my $uri = shift;
        $uri = URI->new($uri) unless blessed $uri;
        $self->_path($uri->path);
        $self->{uri} = $uri->clone;
    }
    return unless defined wantarray;
    return $self->{uri}->clone unless @_;
}


sub path {
    my $self = shift;
    if (@_) {
        my $path = $self->_path(@_);
        $self->{uri}->path($path->get);
    }
    return unless defined wantarray;
    return $self->{path}->clone;
}

sub _path {
    my $self = shift;
    my @path = @_;
    @path = @{ $path[0] } if ref $path[0] eq "ARRAY";
    my $path = Path::Abstract->new(@path);
    $self->{path} = $path;
}


sub clone {
    my $self = shift;
    my $class = ref $self;
    return $class->new($self->uri);
}


sub base {
    my $self = shift;
    if (@_) {
        my $base = shift;
        if (defined $base) {
            my $class = ref $self;
            $base = $base->abs if blessed $base && ($base->isa(__PACKAGE__) || $base->isa('URI::WithBase'));
            $base = $class->new(uri => "$base") unless $base->isa(__PACKAGE__);
        }
        $self->{base} = $base;
    }
    return unless defined wantarray;
    return undef unless defined $self->{base};
    return $self->{base}->clone;
}


sub abs {
    my $self = shift;
    my $class = ref $self;
    my $base = shift || $self->base || return $self->clone;
    return $class->new(uri => $self->uri->abs("$base", @_), base => $base);
}


sub rel {
    my $self = shift;
    my $class = ref $self;
    my $base = shift || $self->base || return $self->clone;
    return $class->new(uri => $self->uri->rel("$base", @_), base => $base);
}

{


    no strict 'refs';

    for my $method (grep { ! /^\s*#/ } split m/\n/, <<_END_) {
scheme
fragment
as_string
canonical
eq
authority
query
query_form
query_keywords
userinfo
host
port
host_port
default_port
_END_
        *$method = sub {
            my $self = shift;
            return $self->{uri}->$method(@_);
        }
    }

#=head2 abs

#Returns a L<URI::PathAbstract> object

#=head2 rel

#Returns a L<URI::PathAbstract> object

#=cut


    for my $method (grep { ! /^\s*#/ } split m/\n/, <<_END_) {
child
parent
_END_
        *$method = sub {
            my $self = shift;
            my $path = $self->{path}->$method(@_);
            my $clone = $self->clone;
            $clone->path($path);
            return $clone;
        }
    }


    for my $method (grep { ! /^\s*#/ } split m/\n/, <<_END_) {
up
pop
down
push
to_tree
to_branch
#set
_END_
        *$method = sub {
            my $self = shift;
            my $path = $self->{path};
            my @result;
            if (wantarray) {
                my @result = $path->$method(@_);
            }
            else {
                $result[0] = $path->$method(@_);
            }
            $self->path($$path);
            return wantarray ? @result : $result[0];
        }
    }
    

    for my $method (grep { ! /^\s*#/ } split m/\n/, <<_END_) {
#get
list
first
last
is_empty
is_nil
is_root
is_tree
is_branch
_END_
        *$method = sub {
            my $self = shift;
            return $self->{path}->$method(@_);
        }
    }
}


1; # End of URI::PathAbstract