File Coverage

File:lib/Yukki/Web/Router/Route.pm
Coverage:96.5%

linestmtbrancondsubpodtimecode
1package Yukki::Web::Router::Route;
2
3
1
1
6
3
use v5.24;
4
1
1
1
2
1
3
use utf8;
5
1
1
1
8
1
2
use Moo;
6
7extends 'Path::Router::Route';
8
9
1
1
1
213
1
4
use Yukki::Types qw( AccessLevel );
10
1
1
1
402
1
15
use Yukki::Web::Router::Route::Match;
11
12
1
1
1
3
2
2
use Types::Standard qw( ArrayRef HashRef Tuple );
13
1
1
1
404
2
25
use List::Util qw( any );
14
15
1
1
1
2
2
2
use namespace::clean;
16
17# ABSTRACT: Adds ACLs to routes
18
19 - 34
=head1 DESCRIPTION

Each route in L<Yukki::Web::Router> is defined using this class.

=head1 EXTENDS

L<Path::Router::Route>

=head1 ATTRIBUTES

=head2 acl

Each route has an access control table here that defines what access levels are
required of a visitor to perform each operation.

=cut
35
36has acl => (
37    is          => 'ro',
38    isa         => ArrayRef[Tuple[AccessLevel,HashRef]],
39    required    => 1,
40);
41
42 - 48
=head1 METHODS

=head2 is_component_slurpy

If the path component is like "*:var" or "+:var", it is slurpy.

=cut
49
50sub is_component_slurpy {
51
295
1
336
    my ($self, $component) = @_;
52
295
1287
    $component =~ /^[+*]:/;
53}
54
55 - 59
=head2 is_component_optional

If the path component is like "?:var" or "*:var", it is optional.

=cut
60
61sub is_component_optional {
62
24
1
174
    my ($self, $component) = @_;
63
24
111
    $component =~ /^[?*]:/;
64}
65
66 - 71
=head2 is_component_variable

If the path component is like "?:var" or "+:var" or "*:var" or ":var", it is a
variable.

=cut
72
73sub is_component_variable {
74
110
1
8446
    my ($self, $component) = @_;
75
110
215
    $component =~ /^[?*+]?:/;
76}
77
78 - 82
=head2 get_component_name

Grabs the name out of a variable.

=cut
83
84sub get_component_name {
85
54
1
76
    my ($self, $component) = @_;
86
54
102
    my ($name) = ($component =~ /^[?*+]?:(.*)$/);
87
54
86
    return $name;
88}
89
90 - 94
=head2 has_slurpy_match

Returns true if any component is slurpy.

=cut
95
96sub has_slurpy_match {
97
123
1
671
    my $self = shift;
98
123
205
123
245
612
1344
    return any { $self->is_component_slurpy($_) } reverse @{ $self->components };
99}
100
101 - 105
=head2 create_default_mapping

If a default value is an array reference, copies that array.

=cut
106
107sub create_default_mapping {
108
48
1
48
    my $self = shift;
109
110
48
48
42
146
    my %defaults = %{ $self->defaults };
111
48
91
    for my $key (keys %defaults) {
112
102
152
        if (ref $defaults{$key} eq 'ARRAY') {
113
12
12
12
23
            $defaults{$key} = [ @{ $defaults{$key} } ];
114        }
115    }
116
117
48
68
    return \%defaults;
118}
119
120 - 124
=head2 match

Adds support for slurpy matching.

=cut
125
126sub match {
127
144
1
6344
    my ($self, $parts) = @_;
128
129    return unless (
130
144
1636
        @$parts >= $self->length_without_optionals &&
131        ($self->has_slurpy_match || @$parts <= $self->length)
132    );
133
134
48
501
    my @parts = @$parts; # for shifting
135
136
48
118
    my $mapping = $self->has_defaults ? $self->create_default_mapping : {};
137
138
48
48
45
557
    for my $c (@{ $self->components }) {
139
94
299
        unless (@parts) {
140
4
11
            die "should never get here: " .
141                "no \@parts left, but more required components remain"
142                if ! $self->is_component_optional($c);
143
4
9
            last;
144        }
145
146
90
97
        my $part;
147
90
115
        if ($self->is_component_slurpy($c)) {
148
12
26
            $part = [ @parts ];
149
12
15
            @parts = ();
150        }
151        else {
152
78
91
            $part = shift @parts;
153        }
154
155
90
129
        if ($self->is_component_variable($c)) {
156
43
61
            my $name = $self->get_component_name($c);
157
158
43
87
            if (my $v = $self->has_validation_for($name)) {
159
43
332
                return unless $v->check($part);
160            }
161
162
43
1644
            $mapping->{$name} = $part;
163        }
164
165        else {
166
47
127
            return unless $c eq $part;
167        }
168    }
169
170
18
307
    return Yukki::Web::Router::Route::Match->new(
171        path    => join('/', @$parts),
172        route   => $self,
173        mapping => $mapping,
174    );
175}
176
1771;