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


line stmt bran cond sub pod time code
1             #####################################################################
2             ## AUTHOR: Mary Ehlers, regina.verbae@gmail.com
3             ## ABSTRACT: Simple path object for labeling locations in Piper pipelines
4             #####################################################################
5              
6             package Piper::Path;
7              
8 5     5   86206 use v5.10;
  5         13  
9 5     5   18 use strict;
  5         6  
  5         83  
10 5     5   16 use warnings;
  5         6  
  5         170  
11              
12 5     5   2487 use Types::Standard qw(ArrayRef Str);
  5         238819  
  5         46  
13              
14 5     5   5671 use Moo;
  5         32603  
  5         24  
15 5     5   7383 use namespace::clean;
  5         30710  
  5         18  
16              
17             use overload (
18 7471     7471   46275 q{""} => sub { $_[0]->stringify },
19 5         43 fallback => 1,
20 5     5   880 );
  5         6  
21              
22             our $VERSION = '0.03'; # from Piper-0.03.tar.gz
23              
24             #pod =head1 SYNOPSIS
25             #pod
26             #pod use Piper::Path;
27             #pod
28             #pod # grandparent/parent/child
29             #pod my $path = Piper::Path->new(qw(
30             #pod grandparent parent child
31             #pod ));
32             #pod
33             #pod # grandparent/parent/child/grandchild
34             #pod $path->child('grandchild');
35             #pod
36             #pod # (qw(grandparent parent child))
37             #pod $path->split;
38             #pod
39             #pod # child
40             #pod $path->name;
41             #pod
42             #pod # 'grandparent/parent/child'
43             #pod $path->stringify;
44             #pod "$path";
45             #pod
46             #pod =head1 DESCRIPTION
47             #pod
48             #pod Simple filesystem-like representation of a pipeline segment's placement in the pipeline, relative to containing segments.
49             #pod
50             #pod =head1 CONSTRUCTOR
51             #pod
52             #pod =head2 new(@path_segments)
53             #pod
54             #pod Creates a L object from the given path segments.
55             #pod
56             #pod Segments may be single path elements (similar to a file name), joined path elements S<(with C)>, or L objects.
57             #pod
58             #pod The following examples create equivalent objects:
59             #pod
60             #pod Piper::Path->new(qw(grandparent parent child));
61             #pod Piper::Path->new(qw(grandparent/parent child));
62             #pod Piper::Path->new(
63             #pod Piper::Path->new(qw(grandparent parent)),
64             #pod qw(child)
65             #pod );
66             #pod
67             #pod =cut
68              
69             has path => (
70             is => 'ro',
71             isa => ArrayRef[Str],
72             );
73              
74             around BUILDARGS => sub {
75             my ($orig, $self, @args) = @_;
76            
77             my @pieces;
78             for my $part (@args) {
79             if (eval { $part->isa('Piper::Path') }) {
80             push @pieces, $part->split;
81             }
82             elsif (ref $part eq 'ARRAY') {
83             push @pieces, map { split('/', $_) } @$part;
84             }
85             else {
86             push @pieces, split('/', $part);
87             }
88             }
89             return $self->$orig(
90             path => \@pieces,
91             );
92             };
93              
94             #pod =head1 METHODS
95             #pod
96             #pod =head2 child(@segments)
97             #pod
98             #pod Returns a new L object representing the appropriate child of L<$self>.
99             #pod
100             #pod $path # grampa/parent
101             #pod $path->child(qw(child)) # grampa/parent/child
102             #pod
103             #pod =cut
104              
105             sub child {
106 26     26 1 1990 my $self = shift;
107 26         340 return $self->new($self, @_);
108             }
109              
110             #pod =head2 name
111             #pod
112             #pod Returns the last segment of the path, similar to the C of a filesystem path.
113             #pod
114             #pod $path # foo/bar/baz
115             #pod $path->name # baz
116             #pod
117             #pod =cut
118              
119             sub name {
120 12     12 1 1025 my ($self) = @_;
121 12         49 return $self->path->[-1];
122             }
123              
124             #pod =head2 split
125             #pod
126             #pod Returns an array of the path segments.
127             #pod
128             #pod $path # foo/bar/baz
129             #pod $path->split # qw(foo bar baz)
130             #pod
131             #pod =cut
132              
133             sub split {
134 607     607 1 2072 my ($self) = @_;
135 607         393 return @{$self->path};
  607         1354  
136             }
137              
138             #pod =head2 stringify
139             #pod
140             #pod Returns a string representation of the path, which is simply a join of the path segments with C.
141             #pod
142             #pod String context is overloaded to call this method. The following are equivalent:
143             #pod
144             #pod $path->stringify
145             #pod "$path"
146             #pod
147             #pod =cut
148              
149             sub stringify {
150 7472     7472 1 6845 my ($self) = @_;
151 7472         4838 return join('/', @{$self->path});
  7472         39673  
152             }
153              
154             1;
155              
156             __END__