File Coverage

blib/lib/Piper/Path.pm

Criterion	Covered	Total	%
statement	31	31	100.0
branch			n/a
condition			n/a
subroutine	12	12	100.0
pod	4	4	100.0
total	47	47	100.0

#####################################################################
## AUTHOR: Mary Ehlers, [e-mail]
## ABSTRACT: Simple path object for labeling locations in Piper pipelines
#####################################################################

package Piper::Path;

use v5.10;
use strict;
use warnings;

use Types::Standard qw(ArrayRef Str);

use Moo;
use namespace::clean;

use overload (
    q{""} => sub { $_[0]->stringify },
    fallback => 1,
);

our $VERSION = '0.04'; # from Piper-0.04.tar.gz

#pod =head1 SYNOPSIS
#pod
#pod     use Piper::Path;
#pod
#pod     # grandparent/parent/child
#pod     my $path = Piper::Path->new(qw(
#pod         grandparent parent child
#pod     ));
#pod
#pod     # grandparent/parent/child/grandchild
#pod     $path->child('grandchild');
#pod
#pod     # (qw(grandparent parent child))
#pod     $path->split;
#pod
#pod     # child
#pod     $path->name;
#pod
#pod     # 'grandparent/parent/child'
#pod     $path->stringify;
#pod     "$path";
#pod
#pod =head1 DESCRIPTION
#pod
#pod Simple filesystem-like representation of a pipeline segment's placement in the pipeline, relative to containing segments.
#pod
#pod =head1 CONSTRUCTOR
#pod
#pod =head2 new(@path_segments)
#pod
#pod Creates a L object from the given path segments.
#pod
#pod Segments may be single path elements (similar to a file name), joined path elements S<(with C)>, or L objects.
#pod
#pod The following examples create equivalent objects:
#pod
#pod     Piper::Path->new(qw(grandparent parent child));
#pod     Piper::Path->new(qw(grandparent/parent child));
#pod     Piper::Path->new(
#pod         Piper::Path->new(qw(grandparent parent)),
#pod         qw(child)
#pod     );
#pod
#pod =cut

has path => (
    is => 'ro',
    isa => ArrayRef[Str],
);

around BUILDARGS => sub {
    my ($orig, $self, @args) = @_;

    my @pieces;
    for my $part (@args) {
        if (eval { $part->isa('Piper::Path') }) {
            push @pieces, $part->split;
        }
        elsif (ref $part eq 'ARRAY') {
            push @pieces, map { split('/', $_) } @$part;
        }
        else {
            push @pieces, split('/', $part);
        }
    }
    return $self->$orig(
        path => \@pieces,
    );
};

#pod =head1 METHODS
#pod
#pod =head2 child(@segments)
#pod
#pod Returns a new L object representing the appropriate child of L<$self>.
#pod
#pod     $path                     # grampa/parent
#pod     $path->child(qw(child))   # grampa/parent/child
#pod
#pod =cut

sub child {
    my $self = shift;
    return $self->new($self, @_);
}

#pod =head2 name
#pod
#pod Returns the last segment of the path, similar to the C of a filesystem path.
#pod
#pod     $path         # foo/bar/baz
#pod     $path->name   # baz
#pod
#pod =cut

sub name {
    my ($self) = @_;
    return $self->path->[-1];
}

#pod =head2 split
#pod
#pod Returns an array of the path segments.
#pod
#pod     $path          # foo/bar/baz
#pod     $path->split   # qw(foo bar baz)
#pod
#pod =cut

sub split {
    my ($self) = @_;
    return @{$self->path};
}

#pod =head2 stringify
#pod
#pod Returns a string representation of the path, which is simply a join of the path segments with C.
#pod
#pod String context is overloaded to call this method.  The following are equivalent:
#pod
#pod     $path->stringify
#pod     "$path"
#pod
#pod =cut

sub stringify {
    my ($self) = @_;
    return join('/', @{$self->path});
}

1;

__END__