File Coverage

blib/lib/Routes/Tiny.pm
Criterion Covered Total %
statement 64 67 95.5
branch 15 18 83.3
condition 2 3 66.6
subroutine 10 10 100.0
pod 5 5 100.0
total 96 103 93.2


line stmt bran cond sub pod time code
1             package Routes::Tiny;
2              
3 18     18   290270 use strict;
  18         47  
  18         594  
4 18     18   101 use warnings;
  18         44  
  18         756  
5              
6             require Carp;
7             require Scalar::Util;
8 18     18   7452 use Routes::Tiny::Pattern;
  18         50  
  18         10690  
9              
10             our $VERSION = 0.21;
11              
12             sub new {
13 52     52 1 34395 my $class = shift;
14 52         164 my (%params) = @_;
15              
16 52         122 my $self = {};
17 52         113 bless $self, $class;
18              
19 52         191 $self->{strict_trailing_slash} = $params{strict_trailing_slash};
20 52         121 $self->{strict_case} = $params{strict_case};
21 52         107 $self->{default_method} = $params{default_method};
22              
23 52         109 $self->{parent_pattern} = undef;
24 52         113 $self->{patterns} = [];
25 52         113 $self->{names} = {};
26             $self->{strict_trailing_slash} = 1
27 52 100       191 unless defined $self->{strict_trailing_slash};
28             $self->{strict_case} = 1
29 52 100       159 unless defined $self->{strict_case};
30              
31 52         159 return $self;
32             }
33              
34             sub add_route {
35 71     71 1 355 my $self = shift;
36              
37 71         204 my $pattern = $self->_build_pattern(@_);
38              
39 70         136 push @{$self->{patterns}}, $pattern;
  70         156  
40              
41 70 100       292 $self->_register_pattern_name($pattern) if $pattern->{name};
42              
43 70         156 return $pattern;
44             }
45              
46             sub mount {
47 13     13 1 68 my $self = shift;
48 13         37 my ($pattern, $routes, @args) = @_;
49              
50 13         35 $pattern = $self->add_route($pattern, subroutes => $routes, @args);
51 13         30 $routes->{parent_pattern} = $pattern;
52 13         22 $self->_register_pattern_name($_) for values %{ $routes->{names} };
  13         51  
53 13         66 Scalar::Util::weaken($routes->{parent_pattern});
54 13         43 return $pattern;
55             }
56              
57             sub match {
58 114     114 1 8330 my $self = shift;
59 114         303 my ($path, @args) = @_;
60              
61 114         204 foreach my $pattern (@{$self->{patterns}}) {
  114         308  
62 171 100       510 if (my $m = $pattern->match($path, @args)) {
63 89         343 return $m;
64             }
65             }
66              
67 25         106 return;
68             }
69              
70             sub build_path {
71 35     35 1 4991 my $self = shift;
72 35         142 my ($name, @args) = @_;
73              
74 35         112 my $pattern = $self->{names}->{$name};
75              
76 35 50       209 return $pattern->build_path(@args) if $pattern;
77              
78 0         0 Carp::croak("Unknown name '$name' used to build a path");
79             }
80              
81             sub _register_pattern_name {
82 52     52   91 my $self = shift;
83 52         118 my ($pattern) = @_;
84              
85 52         155 my $name = $pattern->name;
86 52 50       163 if (exists $self->{names}->{ $name }) {
87 0         0 Carp::carp("pattern name '$name' already used");
88             }
89             else {
90 52         125 $self->{names}->{ $name } = $pattern;
91 52   66     161 my $parent_routes = $self->{parent_pattern} && $self->{parent_pattern}->{routes};
92 52 100       186 if ($parent_routes) {
93 1         4 $parent_routes->_register_pattern_name(@_);
94             }
95             }
96             }
97              
98             sub _build_pattern {
99 71     71   119 my $self = shift;
100              
101 71 100       216 if (@_ % 2) {
102 70         184 unshift(@_, 'pattern');
103             } else {
104 1         2 my $method = shift;
105 1         2 my $pattern = shift;
106              
107 1 50       13 if ($method =~ /^(GET|HEAD|POST|PUT|DELETE|TRACE|OPTIONS|CONNECT|PATCH)$/i) {
108 1         3 unshift(@_, pattern => $pattern);
109 1         3 unshift(@_, method => $method);
110             } else {
111 0         0 Carp::croak("Unknown pattern http method '$_[0]'");
112             }
113             }
114              
115             return Routes::Tiny::Pattern->new(
116             strict_trailing_slash => $self->{strict_trailing_slash},
117             strict_case => $self->{strict_case},
118             default_method => $self->{default_method},
119 71         350 routes => $self,
120             @_
121             )
122             }
123              
124             1;
125             __END__