line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Path::Resource::Base; |
2
|
|
|
|
|
|
|
|
3
|
4
|
|
|
4
|
|
21
|
use warnings; |
|
4
|
|
|
|
|
7
|
|
|
4
|
|
|
|
|
138
|
|
4
|
4
|
|
|
4
|
|
22
|
use strict; |
|
4
|
|
|
|
|
7
|
|
|
4
|
|
|
|
|
297
|
|
5
|
|
|
|
|
|
|
|
6
|
|
|
|
|
|
|
=head1 NAME |
7
|
|
|
|
|
|
|
|
8
|
|
|
|
|
|
|
Path::Resource::Base - A resource base for a Path::Resource object |
9
|
|
|
|
|
|
|
|
10
|
|
|
|
|
|
|
=cut |
11
|
|
|
|
|
|
|
|
12
|
4
|
|
|
4
|
|
3558
|
use Path::Abstract qw/--no_0_093_warning/; |
|
4
|
|
|
|
|
79305
|
|
|
4
|
|
|
|
|
29
|
|
13
|
4
|
|
|
4
|
|
731
|
use Path::Class(); |
|
4
|
|
|
|
|
11
|
|
|
4
|
|
|
|
|
78
|
|
14
|
4
|
|
|
4
|
|
23
|
use Scalar::Util qw/blessed/; |
|
4
|
|
|
|
|
7
|
|
|
4
|
|
|
|
|
220
|
|
15
|
4
|
|
|
4
|
|
3924
|
use URI; |
|
4
|
|
|
|
|
27360
|
|
|
4
|
|
|
|
|
200
|
|
16
|
|
|
|
|
|
|
|
17
|
4
|
|
|
4
|
|
43
|
use base qw/Class::Accessor::Fast/; |
|
4
|
|
|
|
|
7
|
|
|
4
|
|
|
|
|
3336
|
|
18
|
|
|
|
|
|
|
__PACKAGE__->mk_accessors(qw/_dir _loc _uri/); |
19
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
=head1 DESCRIPTION |
21
|
|
|
|
|
|
|
|
22
|
|
|
|
|
|
|
No need to use this class directly, see Path::Resource for more information. |
23
|
|
|
|
|
|
|
|
24
|
|
|
|
|
|
|
=head1 METHODS |
25
|
|
|
|
|
|
|
|
26
|
|
|
|
|
|
|
=over 4 |
27
|
|
|
|
|
|
|
|
28
|
|
|
|
|
|
|
=item $base = Path::Resource::Base->new( dir => $dir, uri => $uri, [ loc => $loc ] ) |
29
|
|
|
|
|
|
|
|
30
|
|
|
|
|
|
|
Create a new Path::Resource::Base object with the given $dir, $uri, and (optional) $loc |
31
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
=cut |
33
|
|
|
|
|
|
|
|
34
|
|
|
|
|
|
|
sub new { |
35
|
94
|
|
|
94
|
1
|
1147
|
my $self = bless {}, shift; |
36
|
94
|
|
|
|
|
381
|
local %_ = @_; |
37
|
|
|
|
|
|
|
|
38
|
94
|
|
|
|
|
162
|
my $dir = $_{dir}; |
39
|
94
|
100
|
66
|
|
|
849
|
$dir = Path::Class::dir($dir) unless blessed $dir && $dir->isa("Path::Class::Dir"); |
40
|
|
|
|
|
|
|
|
41
|
|
|
|
|
|
|
# Extract $uri->path from $uri in order to combine with $loc later |
42
|
94
|
|
|
|
|
229
|
my $uri = $_{uri}; |
43
|
94
|
100
|
66
|
|
|
675
|
$uri = URI->new($uri) unless blessed $uri && $uri->isa("URI"); |
44
|
94
|
|
|
|
|
49578
|
my $uri_path = $uri->path; |
45
|
|
|
|
|
|
|
|
46
|
|
|
|
|
|
|
# If $loc is relative or ($loc is not defined && $uri_path is empty), |
47
|
|
|
|
|
|
|
# this will give us a proper $loc below in any event |
48
|
94
|
100
|
|
|
|
1624
|
$uri_path = "/" unless length $uri_path; |
49
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
# # Set $uri->path to empty, since we'll be using $loc |
51
|
|
|
|
|
|
|
# $uri->path(''); |
52
|
|
|
|
|
|
|
|
53
|
94
|
|
|
|
|
108
|
my $loc; |
54
|
94
|
100
|
|
|
|
227
|
if (defined $_{loc}) { |
55
|
91
|
|
|
|
|
179
|
$loc = $_{loc}; |
56
|
91
|
100
|
66
|
|
|
704
|
$loc = Path::Abstract->new($loc) unless blessed $loc && $loc->isa("Path::Abstract"); |
57
|
91
|
100
|
|
|
|
1855
|
if ($loc->is_branch) { |
58
|
|
|
|
|
|
|
# Combine $loc and $uri_path if $loc is relative |
59
|
35
|
|
|
|
|
408
|
$loc = Path::Abstract->new($uri_path, $loc->path); |
60
|
|
|
|
|
|
|
} |
61
|
|
|
|
|
|
|
} |
62
|
|
|
|
|
|
|
else { |
63
|
3
|
|
|
|
|
33
|
$loc = Path::Abstract->new($uri_path); |
64
|
|
|
|
|
|
|
} |
65
|
|
|
|
|
|
|
|
66
|
94
|
|
|
|
|
2700
|
$self->_dir($dir); |
67
|
94
|
|
|
|
|
789
|
$self->_loc($loc); |
68
|
94
|
|
|
|
|
611
|
$self->_uri($uri); |
69
|
94
|
|
|
|
|
883
|
return $self; |
70
|
|
|
|
|
|
|
} |
71
|
|
|
|
|
|
|
|
72
|
|
|
|
|
|
|
=item $new_base = $base->clone |
73
|
|
|
|
|
|
|
|
74
|
|
|
|
|
|
|
Return a new Path::Resource::Base object that is a clone of $base |
75
|
|
|
|
|
|
|
|
76
|
|
|
|
|
|
|
=cut |
77
|
|
|
|
|
|
|
|
78
|
|
|
|
|
|
|
sub clone { |
79
|
54
|
|
|
54
|
1
|
281
|
my $self = shift; |
80
|
54
|
|
|
|
|
125
|
return __PACKAGE__->new(dir => $self->dir, loc => $self->loc->clone, uri => $self->uri->clone); |
81
|
|
|
|
|
|
|
} |
82
|
|
|
|
|
|
|
|
83
|
|
|
|
|
|
|
=item $base->uri |
84
|
|
|
|
|
|
|
|
85
|
|
|
|
|
|
|
=item $base->uri( $uri ) |
86
|
|
|
|
|
|
|
|
87
|
|
|
|
|
|
|
Return the original $uri, optionally changing it by passing in a new $uri |
88
|
|
|
|
|
|
|
|
89
|
|
|
|
|
|
|
$uri is a URI object, but if you pass in a valid URI string it will Do The Right Thing(tm) and convert it |
90
|
|
|
|
|
|
|
|
91
|
|
|
|
|
|
|
=cut |
92
|
|
|
|
|
|
|
|
93
|
|
|
|
|
|
|
sub uri { |
94
|
78
|
|
|
78
|
1
|
1362
|
my $self = shift; |
95
|
78
|
100
|
|
|
|
299
|
return $self->_uri unless @_; |
96
|
1
|
50
|
33
|
|
|
8
|
return $self->_uri($_[0]) if blessed $_[0] && $_[0]->isa("URI"); |
97
|
1
|
|
|
|
|
6
|
return $self->_uri(URI->new(@_)); |
98
|
|
|
|
|
|
|
# TODO What if $_[0] is undef? |
99
|
|
|
|
|
|
|
} |
100
|
|
|
|
|
|
|
|
101
|
|
|
|
|
|
|
=item $base->loc |
102
|
|
|
|
|
|
|
|
103
|
|
|
|
|
|
|
=item $base->loc( $loc ) |
104
|
|
|
|
|
|
|
|
105
|
|
|
|
|
|
|
Return the calculated $loc, optionally changing it by passing in a new $loc |
106
|
|
|
|
|
|
|
|
107
|
|
|
|
|
|
|
$loc is a Path::Abstract object, but if you pass in a valid Path::Abstract string it will Do The Right Thing(tm) and convert it |
108
|
|
|
|
|
|
|
|
109
|
|
|
|
|
|
|
=cut |
110
|
|
|
|
|
|
|
|
111
|
|
|
|
|
|
|
sub loc { |
112
|
92
|
|
|
92
|
1
|
1812
|
my $self = shift; |
113
|
92
|
100
|
|
|
|
363
|
return $self->_loc unless @_; |
114
|
1
|
50
|
33
|
|
|
13
|
return $self->_loc($_[0]) if 1 == @_ && blessed $_[0] && $_[0]->isa("Path::Abstract"); |
|
|
|
33
|
|
|
|
|
115
|
1
|
|
|
|
|
5
|
return $self->_loc(Path::Abstract->new(@_)); |
116
|
|
|
|
|
|
|
# TODO What if $_[0] is undef? |
117
|
|
|
|
|
|
|
} |
118
|
|
|
|
|
|
|
|
119
|
|
|
|
|
|
|
=item $base->dir |
120
|
|
|
|
|
|
|
|
121
|
|
|
|
|
|
|
=item $base->dir( $dir ) |
122
|
|
|
|
|
|
|
|
123
|
|
|
|
|
|
|
Return the original $dir, optionally changing it by passing in a new $dir |
124
|
|
|
|
|
|
|
|
125
|
|
|
|
|
|
|
$dir is a Path::Class::Dir object, but if you pass in a valid Path::Class::Dir string it will Do The Right Thing(tm) and convert it |
126
|
|
|
|
|
|
|
|
127
|
|
|
|
|
|
|
=cut |
128
|
|
|
|
|
|
|
|
129
|
|
|
|
|
|
|
sub dir { |
130
|
78
|
|
|
78
|
1
|
1476
|
my $self = shift; |
131
|
78
|
100
|
|
|
|
303
|
return $self->_dir unless @_; |
132
|
1
|
50
|
33
|
|
|
15
|
return $self->_dir($_[0]) if 1 == @_ && blessed $_[0] && $_[0]->isa("Path::Class::Dir"); |
|
|
|
33
|
|
|
|
|
133
|
1
|
|
|
|
|
5
|
return $self->_dir(Path::Class::Dir->new(@_)); |
134
|
|
|
|
|
|
|
# TODO What if $_[0] is undef? |
135
|
|
|
|
|
|
|
} |
136
|
|
|
|
|
|
|
|
137
|
|
|
|
|
|
|
1; |