File Coverage

blib/lib/Path/Mapper.pm

Criterion	Covered	Total	%
statement	61	66	92.4
branch	16	24	66.6
condition			n/a
subroutine	11	12	91.6
pod	6	6	100.0
total	94	108	87.0

package Path::Mapper;
BEGIN {
  $Path::Mapper::VERSION = '0.012';
}
# ABSTRACT: Map a virtual path to an actual one

use warnings;
use strict;


use Any::Moose;
use Path::Abstract();
use Path::Class();

has _map => qw/is ro isa HashRef required 1/, default => sub { {} };

sub BUILD {
    my $self = shift;
    my $given = shift;

    my $base = $given->{base};
    $base = '' unless defined $base;

    $self->map( '' => $base );
}


sub base {
    my $self = shift;
    if (@_) {
        $self->map( '' => shift );
    }
    return $self->_map->{''};
}

sub map {
    my $self = shift;
    if (@_ == 2) {
        my $virtual = shift;
        my $actual = shift;

        $virtual = '' unless defined $virtual; # Undefined behavior, set the base path
        $virtual = "/$virtual"; # Normalize with leading slash
        $virtual =~ s/\/*$//; # Get rid of trailing slash(es)
        $virtual = Path::Abstract->new( $virtual );
        $virtual = Path::Abstract->new( '' ) if $virtual->is_root;

        if (defined $actual) {
            $actual = Path::Abstract->new( $actual.'' ) if defined $actual;
            $self->_map->{$virtual.''} = $actual;
        }
        else {
            delete $self->_map->{$virtual.''};
        }
    }
    else {
        my $query = shift;
        $query = '' unless defined $query; # Undefined behavior

        $query = Path::Abstract->new( "/$query" ); # Normalize with leading slash
        my $query_ = $query.'';
        study $query_;

        my $found = '';
        for my $virtual (keys %{ $self->_map }) {
            if ($query =~ m/^$virtual(?:\/|$)/) {
                if (length $virtual > length $found) {
                    $found = $virtual;
                }
            }
        }

        my $base = $self->_map->{$found};
        my $remainder = substr $query, length $found;
        substr $remainder, 0, 1, '' if 0 == index $remainder, '/';

        my @result = ($base.'', $remainder);
        return wantarray ? @result : \@result;
    }
}

sub dir {
    my $self = shift;
    my ($base, $remainder) = $self->map( shift );
    return Path::Class::Dir->new( grep { length $_ } $base, $remainder );
}

sub file {
    my $self = shift;
    my ($base, $remainder) = $self->map( shift );
    return Path::Class::File->new( grep { length $_ } $base, $remainder );
}

sub path {
    my $self = shift;
    my ($base, $remainder) = $self->map( shift );
    return Path::Abstract->new( grep { length $_ } $base, $remainder );
}

1;

__END__