view release on metacpan or  search on metacpan

lib/URI/Platonic.pm  view on Meta::CPAN

package URI::Platonic;

use Moose;
use MooseX::Types::URI qw(Uri);
use overload '""' => \&as_string, fallback => 1;

has 'uri' => (
    is       => 'ro',
    isa      => Uri,
    coerce   => 1,
    required => 1,
);

# no Moose handles ?
{
    my @handles = qw(
        authority opaque userinfo host_port
        scheme host port path query fragment
        path_query path_segments
        query_form query_keywords
        as_string
    );

    for my $method (@handles) {
        __PACKAGE__->meta->add_method($method, sub {
            my $self = shift;
            $self->uri->$method(@_);
        });
    }
}

has 'extension' => (
    is  => 'rw',
    isa => 'Str',
);

no Moose;

our $VERSION = '0.03';

sub BUILD {
    my $self = shift;

    my $path = $self->uri->path;
    if ($path =~ m![^/]+\.([^/\.]+)$!) {
        $self->extension($1);
        $path =~ s/\.$1$//;
        $self->uri->path($path);
    }
}

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

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

sub platonic {
    my $self = shift;
    return $self->uri->clone;
}

sub distinct {
    my $self = shift;

    my $uri = $self->uri->clone;
    if ($self->extension) {
        $uri->path(join '.', $uri->path, $self->extension);
    }

    return $uri;
}

1;