1package Path::Resource::Base;
2
3use warnings;
4use strict;
5
6=head1 NAME
7
8Path::Resource::Base - A resource base for a Path::Resource object
9
10=cut
11
12use Path::Abstract qw/--no_0_093_warning/;
13use Path::Class();
14use Scalar::Util qw/blessed/;
15use URI;
16
17use base qw/Class::Accessor::Fast/;
18__PACKAGE__->mk_accessors(qw/_dir _loc _uri/);
19
20=head1 DESCRIPTION
21
22No 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
30Create a new Path::Resource::Base object with the given $dir, $uri, and (optional) $loc
31
32=cut
33
34sub new {
35	my $self = bless {}, shift;
36	local %_ = @_;
37
38	my $dir = $_{dir};
39	$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	my $uri = $_{uri};
43	$uri = URI->new($uri) unless blessed $uri && $uri->isa("URI");
44	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    $uri_path = "/" unless length $uri_path;
49
50#   # Set $uri->path to empty, since we'll be using $loc
51#   $uri->path('');
52
53	my $loc;
54	if (defined $_{loc}) {
55		$loc = $_{loc};
56		$loc = Path::Abstract->new($loc) unless blessed $loc && $loc->isa("Path::Abstract");
57		if ($loc->is_branch) {
58            # Combine $loc and $uri_path if $loc is relative
59			$loc = Path::Abstract->new($uri_path, $loc->path);
60		}
61	}
62	else {
63		$loc = Path::Abstract->new($uri_path);
64	}
65
66	$self->_dir($dir);
67	$self->_loc($loc);
68	$self->_uri($uri);
69	return $self;
70}
71
72=item $new_base = $base->clone
73
74Return a new Path::Resource::Base object that is a clone of $base
75
76=cut
77
78sub clone {
79	my $self = shift;
80	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
87Return 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
93sub uri {
94    my $self = shift;
95    return $self->_uri unless @_;
96    return $self->_uri($_[0]) if blessed $_[0] && $_[0]->isa("URI");
97    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
105Return 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
111sub loc {
112    my $self = shift;
113    return $self->_loc unless @_;
114    return $self->_loc($_[0]) if 1 == @_ && blessed $_[0] && $_[0]->isa("Path::Abstract");
115    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
123Return 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
129sub dir {
130    my $self = shift;
131    return $self->_dir unless @_;
132    return $self->_dir($_[0]) if 1 == @_ && blessed $_[0] && $_[0]->isa("Path::Class::Dir");
133    return $self->_dir(Path::Class::Dir->new(@_));
134    # TODO What if $_[0] is undef?
135}
136
1371;
138