File Coverage

blib/lib/Articulate/Navigation.pm
Criterion Covered Total %
statement 21 40 52.5
branch 2 6 33.3
condition 0 3 0.0
subroutine 6 8 75.0
pod 3 3 100.0
total 32 60 53.3


line stmt bran cond sub pod time code
1             package Articulate::Navigation;
2 5     5   2639 use strict;
  5         10  
  5         199  
3 5     5   24 use warnings;
  5         7  
  5         117  
4              
5 5     5   18 use Moo;
  5         5  
  5         24  
6             with 'Articulate::Role::Component';
7              
8 5     5   1194 use Articulate::Location;
  5         7  
  5         38  
9 5     5   1699 use Articulate::LocationSpecification;
  5         11  
  5         27  
10              
11             =head1 NAME
12              
13             Articulate::Navigation - determine valid locations
14              
15             =head1 SYNOPSIS
16              
17             components:
18             navigation:
19             Articulate::Navigation:
20             locations:
21             - zone/*
22             - zone/*/article/*
23             - user/*
24             - []
25              
26             Provides validation for locations.
27              
28             =head1 ATTRIBUTE
29              
30             =head3 locations
31              
32             Any location specifications configured in the locations attribute are valid locations for deposition and retrieval of items from storage.
33              
34             =cut
35              
36             has locations => (
37             is => 'rw', # rwp?
38             default => sub { [] },
39             coerce => sub {
40             my $orig = shift;
41             my $new = [];
42             foreach my $l ( @{$orig} ) {
43             push @$new, locspec $l;
44             }
45             return $new;
46             },
47             );
48              
49             # A locspec is like a location except it can contain "*": "/zone/*/article/"
50              
51             =head1 METHODS
52              
53             =cut
54              
55             =head3 valid_location
56              
57             do_something if $self->valid_location('zone/public')
58             do_something if $self->valid_location($location_object)
59              
60             Returns the location if valid (matches one of the locspecs in C), undef otherwise.
61              
62             =cut
63              
64             sub valid_location {
65 101     101 1 4642 my $self = shift;
66 101         235 my $location = loc shift;
67 101         221 foreach my $defined_location ( @{ $self->locations } ) {
  101         1878  
68 190 100       1962 if ( $defined_location->matches($location) ) {
69 101         454 return $location;
70             }
71             }
72 0           return undef;
73             }
74              
75             =head3 define_locspec
76              
77             $self->define_locspec('zone/*')
78             $self->define_locspec($locspec)
79              
80             Adds a locspec to C, unless it is already there
81              
82             =cut
83              
84             sub define_locspec {
85 0     0 1   my $self = shift;
86 0           my $location = locspec shift;
87 0           foreach my $defined_location ( @{ $self->locations } ) {
  0            
88 0 0         if ( ( $location eq $defined_location ) ) {
89 0           return undef;
90             }
91             }
92 0           push @{ $self->locations }, $location;
  0            
93             }
94              
95             =head3 undefine_locspec
96              
97             $self->undefine_locspec('zone/*')
98             $self->undefine_locspec($locspec)
99              
100             Removes a locspec from C.
101              
102             =cut
103              
104             sub undefine_locspec {
105 0     0 1   my $self = shift;
106 0           my $location = locspec shift;
107 0           my ( $removed, $kept ) = ( [], [] );
108 0           foreach my $defined_location ( @{ $self->locations } ) {
  0            
109 0 0 0       if ( ( $location eq $defined_location )
110             or $defined_location->matches_descendant_of($location) )
111             {
112 0           push @$removed, $location;
113             }
114             else {
115 0           push @$kept, $location;
116             }
117             }
118 0           $self->locations($kept);
119 0           return $removed;
120             }
121              
122             =head1 SEE ALSO
123              
124             =over
125              
126             =item * L
127              
128             =item * L
129              
130             =back
131              
132             =cut
133              
134             1;