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.

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