File: | lib/Dancer/Plugin/BeforeRoute.pm |
Coverage: | 100.0% |
line | stmt | time | code |
---|---|---|---|
1 | 4 4 4 | 960 14 190 | use strict; |
2 | 4 4 4 | 43 10 358 | use warnings; |
3 | |||
4 | package Dancer::Plugin::BeforeRoute; | ||
5 | 4 4 4 | 36 7 481 | use Carp "confess"; |
6 | 4 4 4 | 3059 1196681 36 | use Dancer ":syntax"; |
7 | 4 4 4 | 5616 9686 7641 | use Dancer::Plugin; |
8 | |||
9 | my %BEFORE_COLLECTIONS = (); | ||
10 | my $SETUP_ALL_HOOK = 0; | ||
11 | |||
12 | register before_route => sub { | ||
13 | 4 | 13 | before_of( before => @_ ); |
14 | }; | ||
15 | |||
16 | register before_of => sub { | ||
17 | 5 | 14 | my $hook_name = _hook_name( before => shift ); |
18 | 5 | 17 | my ( $path, $subref, @methods ) = _args(@_); |
19 | 5 | 15 | my $collection_ref = _collection($hook_name); |
20 | 5 | 39 | push @$collection_ref, |
21 | { | ||
22 | methods => \@methods, | ||
23 | path => $path, | ||
24 | subref => $subref, | ||
25 | }; | ||
26 | }; | ||
27 | |||
28 | register request_for => sub { | ||
29 | 30 | 66 | my $hook = shift |
30 | or confess "dev: Missing hook name"; | ||
31 | 30 | 58 | my $path = shift |
32 | or confess "dev: Missing route path"; | ||
33 | 30 | 102 | my @methods = @_ |
34 | or confess "dev: Missing methods"; | ||
35 | |||
36 | 30 | 97 | my $request_method = request->method; |
37 | 30 | 460 | my $request_path = request->path_info; |
38 | |||
39 | 30 | 190 | grep { |
40 | 30 | 397 | info( "$hook is trying to match " |
41 | . qq{'$request_method $request_path'} | ||
42 | . qq{against '$_ $path'} ) | ||
43 | } @methods; | ||
44 | |||
45 | 30 | 1914 | return if !_is_the_right_method( $request_method, @methods ); |
46 | 19 | 59 | return if !_is_the_right_path( $request_path, $path ); |
47 | |||
48 | 5 | 27 | info "--> got 1"; |
49 | |||
50 | 5 | 307 | return 1; |
51 | }; | ||
52 | |||
53 | ## Only run once setup the hooks | ||
54 | hook before => \&_setup_before_route_hooks; | ||
55 | |||
56 | sub _hook_name { | ||
57 | 5 | 11 | my $prefix = shift; |
58 | 5 | 19 | my $name = shift |
59 | or confess "dev: missing hook name\n"; | ||
60 | 5 | 58 | return $name =~ m/^$prefix/ |
61 | ? $name | ||
62 | : $prefix . "_" . $name; | ||
63 | } | ||
64 | |||
65 | sub _args { | ||
66 | 10 | 859 | my $methods = shift |
67 | or confess "dev: missing method\n"; | ||
68 | |||
69 | 9 | 39 | my @methods = ref $methods ? @$methods : ($methods); |
70 | |||
71 | 9 | 728 | my $path = shift |
72 | or confess "dev: missing path\n"; | ||
73 | 8 | 666 | my $subref = shift |
74 | or confess "dev: missing a subref -> [[ @methods: $path ]]\n"; | ||
75 | |||
76 | 7 | 47 | return ( $path, $subref, @methods ); |
77 | } | ||
78 | |||
79 | sub _is_the_right_method { | ||
80 | 30 | 63 | my $method = shift; |
81 | 30 | 87 | my @methods = shift; |
82 | 30 30 | 70 316 | return ( grep { /^\Q$method\E$/i } @methods ) ? 1 : 0; |
83 | } | ||
84 | |||
85 | sub _is_the_right_path { | ||
86 | 19 | 31 | my $got_path = shift; |
87 | 19 | 32 | my $expected_path = shift; |
88 | 19 | 69 | if ( ref $expected_path ) { |
89 | 2 | 43 | return $got_path =~ /$expected_path/ ? 1 : 0; |
90 | } | ||
91 | 17 | 40 | if ( $expected_path =~ /\:/ ) { |
92 | 5 | 39 | $expected_path =~ s/\:[^\/]+/[^\/]+/g; |
93 | 5 | 75 | return $got_path =~ /$expected_path/ ? 1 : 0; |
94 | } | ||
95 | 12 | 70 | return $got_path eq $expected_path ? 1 : 0; |
96 | } | ||
97 | |||
98 | sub _collection { | ||
99 | 7 | 25 | my $hook_name = shift |
100 | or confess "dev: missing hook name"; | ||
101 | 7 | 61 | $BEFORE_COLLECTIONS{$hook_name} ||= []; |
102 | } | ||
103 | |||
104 | sub _setup_before_route_hooks { | ||
105 | ## Just return at second time | ||
106 | 9 | 17416 | return if $SETUP_ALL_HOOK; |
107 | |||
108 | ## Run at first time | ||
109 | 2 | 12 | foreach my $hook_name ( keys %BEFORE_COLLECTIONS ) { |
110 | 2 | 164 | my $collection_ref = _collection($hook_name); |
111 | hook $hook_name => sub { | ||
112 | 9 | 766 | _scan_routes_and_execute( $hook_name, \@_, @$collection_ref ); |
113 | } | ||
114 | 2 | 20 | } |
115 | |||
116 | 2 | 128 | $SETUP_ALL_HOOK = 1; |
117 | } | ||
118 | |||
119 | sub _scan_routes_and_execute { | ||
120 | 9 | 27 | my $hook_name = shift |
121 | or confess "dev: Missing hook name"; | ||
122 | 9 | 18 | my $args = shift; |
123 | 9 | 30 | my @routes = @_; |
124 | |||
125 | ROUTE: | ||
126 | 9 | 23 | foreach my $route (@routes) { |
127 | next ROUTE | ||
128 | 30 30 | 98 95 | if !request_for( $hook_name, $route->{path}, @{ $route->{methods} } ); |
129 | 5 | 22 | $route->{subref}->(@$args); |
130 | } | ||
131 | } | ||
132 | |||
133 | register_plugin; | ||
134 |