File Coverage

blib/lib/Articulate/LocationSpecification.pm

Criterion	Covered	Total	%
statement	52	65	80.0
branch	23	42	54.7
condition	2	6	33.3
subroutine	13	15	86.6
pod	6	6	100.0
total	96	134	71.6

package Articulate::LocationSpecification;
use strict;
use warnings;

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

=cut

=head1 FUNCTIONS

=head3 locspec

C 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 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 ATTRIBUTE

=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 { []; },
);

=head1 METHODS

=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 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;
}

=head1 SEE ALSO

=over

=item * L

=item * L

=back

=cut

1;