use strict;
use Moo;
use Scalar::Util qw(blessed);
use overload '""' => \&to_file_path, '@{}' => sub{ shift->path };
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;