File Coverage

blib/lib/Path/AttrRouter/DispatchType/Path.pm
Criterion Covered Total %
statement 38 52 73.0
branch 20 28 71.4
condition 3 7 42.8
subroutine 6 7 85.7
pod 0 5 0.0
total 67 99 67.6


line stmt bran cond sub pod time code
1             package Path::AttrRouter::DispatchType::Path;
2 7     7   4976 use Mouse;
  7         15  
  7         57  
3              
4             has name => (
5             is => 'rw',
6             isa => 'Str',
7             default => 'Path',
8             );
9              
10             has paths => (
11             is => 'rw',
12             isa => 'HashRef',
13             lazy => 1,
14             default => sub { {} },
15             );
16              
17 7     7   3234 no Mouse;
  7         19  
  7         37  
18              
19             sub match {
20 105     105 0 184 my ($self, $condition) = @_;
21              
22 105         165 my $path = $condition->{path};
23              
24 105 100 33     412 $path = '/' if !defined $path || !length $path;
25              
26 105 100       107 for my $action (@{ $self->paths->{$path} || [] }) {
  105         586  
27 73 100       218 return $action if $action->match($condition);
28             }
29              
30 72         189 return;
31             }
32              
33             sub register {
34 52     52 0 78 my ($self, $action) = @_;
35              
36 52 100       60 my @register_paths = @{ $action->attributes->{Path} || [] }
  52 100       429  
37             or return;
38              
39 29         49 for my $path (@register_paths) {
40 29         69 $self->register_path( $path => $action );
41             }
42              
43 29         93 1;
44             }
45              
46             sub used {
47 1     1 0 2 my $self = shift;
48 1         2 scalar( keys %{ $self->paths } );
  1         5  
49             }
50              
51             sub register_path {
52 29     29 0 46 my ($self, $path, $action) = @_;
53              
54 29         64 $path =~ s!^/!!;
55 29 100       73 $path = '/' unless length $path;
56              
57 29   100     159 my $actions = $self->paths->{ $path } ||= [];
58 29         161 my $num_args = $action->num_args;
59              
60 29 100       75 unless (@$actions) {
61 18         35 push @$actions, $action;
62 18         53 return;
63             }
64              
65 11 100       26 if (defined $num_args) {
66 10         12 my $p;
67 10         72 for ($p = 0; $p < @$actions; ++$p) {
68 14 50       56 last unless defined $actions->[$p]->num_args;
69 14 100       78 last if $actions->[$p]->num_args <= $num_args;
70             }
71              
72 10 50       23 unless (defined $p) {
73 0         0 unshift @$actions, $action;
74             }
75             else {
76 10         70 @$actions = (@$actions[0..$p-1], $action, @$actions[$p..$#$actions]);
77             }
78             }
79             else {
80 1         4 push @$actions, $action;
81             }
82             }
83              
84             sub list {
85 0     0 0   my ($self) = @_;
86 0 0         return unless $self->used;
87              
88 0           my @rows = [[ 1 => 'Path'], [ 1 => 'Private' ]];
89              
90 0           for my $path (sort keys %{ $self->paths }) {
  0            
91 0           for my $action (@{ $self->paths->{ $path } }) {
  0            
92 0 0         my $display_path = $path eq '/' ? '' : "/$path";
93              
94 0 0         if (defined $action->num_args) {
95 0           $display_path .= '/*' for 1 .. $action->num_args;
96             }
97             else {
98 0           $display_path .= '/...';
99             }
100              
101 0   0       push @rows, [ $display_path || '/', '/' . $action->reverse ];
102             }
103             }
104              
105 0           return \@rows;
106             }
107              
108             __PACKAGE__->meta->make_immutable;