———————package
Articulate::LocationSpecification;
use
strict;
use
warnings;
use
Moo;
use
Articulate::Location;
use
Exporter::Declare;
default_exports
qw(locspec)
;
=head1 NAME
Articulate::LocationSpecification - represent a specification
=cut
=head1 DESCRIPTION
locspec ['zone', '*', 'article', 'hello-world']
locspec 'zone/*/article/hello-world' # same thing
An object class which represents a specification - like a 'pattern' or 'glob', and provides methods so that it can be compared with locations. It is similar to C<Articulate::Location>, and stringifies to the 'file path' representation.
The main use of this is to determine whether a user has access to a resource based on rules.
=cut
=head1 FUNCTIONS
=head3 locspec
C<locspec> is a constructor. It takes either a string (in the form of a path) or an arrayref. Either will be stored as an arrayref in the C<path> attribute.
=cut
sub
locspec {
if
( 1 ==
scalar
@_
) {
if
( blessed
$_
[0] and
$_
[0]->isa(
'Articulate::LocationSpecification'
) ) {
return
$_
[0];
}
elsif
( blessed
$_
[0] and
$_
[0]->isa(
'Articulate::Location'
) ) {
my
$path
=
$_
[0]->path;
# should this logic be in the coerce?
if
(
@$path
) {
for
my
$i
(1..
$#$path
) {
if
(0 == (
$i
% 2) ) {
$path
->[
$i
] =
'*'
;
}
}
}
return
__PACKAGE__->new({
path
=>
$path
});
}
elsif
(
ref
$_
[0] eq
'ARRAY'
) {
return
__PACKAGE__->new({
path
=>
$_
[0] });
}
elsif
( !
defined
$_
[0] ) {
return
__PACKAGE__->new;
}
elsif
( !
ref
$_
[0] ) {
return
__PACKAGE__->new({
path
=> [
grep
{
$_
ne
''
}
split
/\//,
$_
[0] ] });
}
elsif
(
ref
$_
[0] eq
'HASH'
) {
return
__PACKAGE__->new(
$_
[0]);
}
}
};
=head1 METHODS
=head3 path
An arrayref representing the path to the location specification. This is used for overloaded array dereferencing.
=cut
has
path
=> (
is
=>
'rw'
,
default
=>
sub
{ []; },
);
=head3 location
$locspec->location->location # same as $locspec
This method always returns the object itself.
=cut
sub
location {
return
shift
;
}
=head3 to_file_path
Joins the contents of C<path> on C</> and returns the result. This is used for overloaded stringification.
=cut
sub
to_file_path {
return
join
'/'
, @{
$_
[0]->path }
};
sub
_step_matches {
my
(
$left
,
$right
) =
@_
;
return
1
if
(
$left
eq
'*'
);
return
1
if
(
$right
eq
'*'
);
return
1
if
(
$left
eq
$right
);
return
0;
}
=head3 matches
locspec('/zone/*')->matches(loc('/zone/public')) # true
locspec('/zone/*')->matches(loc('/')) # false
locspec('/zone/*')->matches(loc('/zone/public/article/hello-world')) # false
Determines if the location given as the first argument matches the locspec.
=cut
sub
matches {
my
$self
=
shift
;
my
$location
= loc
shift
;
return
0
unless
$#$self
==
$#$location
;
return
1
if
$#$self
== -1; # go
no
further
if
both are empty
for
my
$i
(0..
$#$self
) {
return
0
unless
_step_matches(
$self
->[
$i
],
$location
->[
$i
] );
}
return
1;
}
=head3 matches_ancestor_of
locspec('/zone/*')->matches_ancestor_of(loc('/zone/public')) # true
locspec('/zone/*')->matches_ancestor_of(loc('/')) # false
locspec('/zone/*')->matches_ancestor_of(loc('/zone/public/article/hello-world')) # true
Determines if the location given as the first argument - or any ancestor thereof - matches the locspec.
=cut
sub
matches_ancestor_of {
my
$self
=
shift
;
my
$location
= loc
shift
;
return
0
unless
$#$self
<=
$#$location
;
return
1
if
$#$self
== -1; # go
no
further
if
self is empty
for
my
$i
(0..
$#$self
) {
return
0
unless
_step_matches(
$self
->[
$i
],
$location
->[
$i
] );
}
return
1;
}
=head3 matches_descendant_of
locspec('/zone/*')->matches_descendant_of(loc('/zone/public')) # true
locspec('/zone/*')->matches_descendant_of(loc('/')) # true
locspec('/zone/*')->matches_descendant_of(loc('/zone/public/article/hello-world')) # false
Determines if the location given as the first argument - or any descendant thereof - matches the locspec.
=cut
sub
matches_descendant_of {
my
$self
=
shift
;
my
$location
= loc
shift
;
return
0
unless
$#$self
>=
$#$location
;
return
1
if
$#$location
== -1; # go
no
further
if
self is empty
for
my
$i
(0..
$#$location
) {
return
0
unless
_step_matches(
$self
->[
$i
],
$location
->[
$i
] );
}
return
1;
}
1;