File Coverage

File:lib/Dancer/Plugin/BeforeRoute.pm
Coverage:100.0%

linestmttimecode
1
4
4
4
960
14
190
use strict;
2
4
4
4
43
10
358
use warnings;
3
4package 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
9my %BEFORE_COLLECTIONS = ();
10my $SETUP_ALL_HOOK = 0;
11
12register before_route => sub {
13
4
13
    before_of( before => @_ );
14};
15
16register 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
28register 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
54hook before => \&_setup_before_route_hooks;
55
56sub _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
65sub _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
79sub _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
85sub _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
98sub _collection {
99
7
25
    my $hook_name = shift
100      or confess "dev: missing hook name";
101
7
61
    $BEFORE_COLLECTIONS{$hook_name} ||= [];
102}
103
104sub _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
119sub _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
133register_plugin;
134