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