line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Router::Pygmy::Route; |
2
|
|
|
|
|
|
|
$Router::Pygmy::Route::VERSION = '0.05'; |
3
|
1
|
|
|
1
|
|
3
|
use strict; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
26
|
|
4
|
1
|
|
|
1
|
|
3
|
use warnings; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
22
|
|
5
|
|
|
|
|
|
|
|
6
|
|
|
|
|
|
|
# ABSTRACT: simple route object |
7
|
|
|
|
|
|
|
|
8
|
1
|
|
|
1
|
|
3
|
use Carp; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
586
|
|
9
|
|
|
|
|
|
|
our @CARP_NOT = qw(Router::Pygmy); |
10
|
|
|
|
|
|
|
|
11
|
10
|
|
|
10
|
0
|
99
|
sub spec { shift()->{spec}; } |
12
|
|
|
|
|
|
|
|
13
|
15
|
|
|
15
|
0
|
20
|
sub arg_names { shift()->{arg_names}; } |
14
|
|
|
|
|
|
|
|
15
|
5
|
|
|
5
|
0
|
11
|
sub arg_idxs { shift()->{arg_idxs}; } |
16
|
|
|
|
|
|
|
|
17
|
24
|
|
|
24
|
0
|
57
|
sub parts { shift()->{parts}; } |
18
|
|
|
|
|
|
|
|
19
|
|
|
|
|
|
|
sub new { |
20
|
11
|
|
|
11
|
0
|
33
|
my ($class, %fields) = @_; |
21
|
11
|
|
|
|
|
28
|
return bless(\%fields, $class); |
22
|
|
|
|
|
|
|
} |
23
|
|
|
|
|
|
|
|
24
|
|
|
|
|
|
|
sub parse { |
25
|
11
|
|
|
11
|
0
|
13
|
my ( $class, $spec ) = @_; |
26
|
|
|
|
|
|
|
|
27
|
11
|
|
|
|
|
9
|
my ( @arg_names, @arg_idxs, @parts ); |
28
|
11
|
|
|
|
|
10
|
my $i = 0; |
29
|
11
|
|
|
|
|
26
|
for my $part ( grep { $_ } split m{/}, $spec ) { |
|
33
|
|
|
|
|
41
|
|
30
|
33
|
|
|
|
|
58
|
my $is_arg = $part =~ s/^://; |
31
|
33
|
100
|
|
|
|
45
|
if ($is_arg) { |
32
|
16
|
|
|
|
|
14
|
push @parts, undef; |
33
|
16
|
|
|
|
|
14
|
push @arg_idxs, $i; |
34
|
16
|
|
|
|
|
16
|
push @arg_names, $part; |
35
|
|
|
|
|
|
|
} |
36
|
|
|
|
|
|
|
else { |
37
|
17
|
|
|
|
|
19
|
push @parts, $part; |
38
|
|
|
|
|
|
|
} |
39
|
33
|
|
|
|
|
34
|
$i++; |
40
|
|
|
|
|
|
|
} |
41
|
11
|
|
|
|
|
24
|
return $class->new( |
42
|
|
|
|
|
|
|
spec => $spec, |
43
|
|
|
|
|
|
|
parts => \@parts, |
44
|
|
|
|
|
|
|
arg_names => \@arg_names, |
45
|
|
|
|
|
|
|
arg_idxs => \@arg_idxs, |
46
|
|
|
|
|
|
|
); |
47
|
|
|
|
|
|
|
} |
48
|
|
|
|
|
|
|
|
49
|
|
|
|
|
|
|
sub path_for { |
50
|
13
|
|
|
13
|
0
|
10
|
my $this = shift; |
51
|
|
|
|
|
|
|
|
52
|
13
|
|
|
|
|
12
|
my @parts = @{ $this->parts }; |
|
13
|
|
|
|
|
19
|
|
53
|
13
|
|
|
|
|
23
|
@parts[ @{ $this->arg_idxs } ] = $this->args_for(@_); |
|
5
|
|
|
|
|
17
|
|
54
|
5
|
|
|
|
|
27
|
return join '/', @parts; |
55
|
|
|
|
|
|
|
} |
56
|
|
|
|
|
|
|
|
57
|
|
|
|
|
|
|
sub args_for { |
58
|
13
|
|
|
13
|
0
|
12
|
my $this = shift; |
59
|
13
|
100
|
33
|
|
|
69
|
my $args |
|
|
50
|
|
|
|
|
|
60
|
|
|
|
|
|
|
= !@_ || !defined $_[0] ? [] |
61
|
|
|
|
|
|
|
: !ref $_[0] ? [ shift() ] |
62
|
|
|
|
|
|
|
: shift(); |
63
|
|
|
|
|
|
|
|
64
|
13
|
|
|
|
|
26
|
my $arg_names = $this->arg_names; |
65
|
|
|
|
|
|
|
|
66
|
13
|
100
|
|
|
|
31
|
if ( ref $args eq 'ARRAY' ) { |
|
|
50
|
|
|
|
|
|
67
|
|
|
|
|
|
|
|
68
|
|
|
|
|
|
|
# positional args |
69
|
7
|
100
|
|
|
|
16
|
@$args == @$arg_names |
70
|
|
|
|
|
|
|
or croak sprintf |
71
|
|
|
|
|
|
|
"Invalid arg count for route '%s', got %d args, expected %d", |
72
|
|
|
|
|
|
|
$this->spec, scalar @$args, scalar @$arg_names; |
73
|
3
|
|
|
|
|
5
|
return @$args; |
74
|
|
|
|
|
|
|
} |
75
|
|
|
|
|
|
|
elsif ( ref $args eq 'HASH' ) { |
76
|
|
|
|
|
|
|
|
77
|
|
|
|
|
|
|
# named args |
78
|
|
|
|
|
|
|
keys %$args == @$arg_names |
79
|
4
|
|
|
|
|
19
|
&& not( grep { !exists $args->{$_}; } @$arg_names ) |
80
|
|
|
|
|
|
|
or croak sprintf |
81
|
|
|
|
|
|
|
"Invalid args for route '%s', got (%s) expected (%s)", |
82
|
|
|
|
|
|
|
$this->spec, |
83
|
7
|
|
|
|
|
20
|
join( ', ', map {"'$_'"} sort { $a cmp $b } keys %$args ), |
|
3
|
|
|
|
|
7
|
|
84
|
6
|
100
|
100
|
|
|
27
|
join( ', ', map {"'$_'"} @$arg_names ); |
|
6
|
|
|
|
|
53
|
|
85
|
|
|
|
|
|
|
|
86
|
2
|
|
|
|
|
7
|
return @$args{@$arg_names}; |
87
|
|
|
|
|
|
|
} |
88
|
|
|
|
|
|
|
else { |
89
|
0
|
|
|
|
|
|
croak sprintf "Invalid args for route '%s' (%s)", $this->spec, $args; |
90
|
|
|
|
|
|
|
} |
91
|
|
|
|
|
|
|
} |
92
|
|
|
|
|
|
|
|
93
|
|
|
|
|
|
|
1; |
94
|
|
|
|
|
|
|
|
95
|
|
|
|
|
|
|
# vim: expandtab:shiftwidth=4:tabstop=4:softtabstop=0:textwidth=78: |
96
|
|
|
|
|
|
|
|
97
|
|
|
|
|
|
|
__END__ |