File Coverage

blib/lib/Dancer2/Plugin/ParamTypes.pm
Criterion Covered Total %
statement 99 100 99.0
branch 33 42 78.5
condition 9 12 75.0
subroutine 15 15 100.0
pod 3 4 75.0
total 159 173 91.9


line stmt bran cond sub pod time code
1             package Dancer2::Plugin::ParamTypes;
2             # ABSTRACT: Parameter type checking plugin for Dancer2
3             $Dancer2::Plugin::ParamTypes::VERSION = '0.005';
4 7     7   5796538 use strict;
  7         68  
  7         225  
5 7     7   42 use warnings;
  7         16  
  7         271  
6             use constant {
7 7         744 'ARGS_NUM_BASIC' => 3,
8             'ARGS_NUM_OPTIONAL' => 4,
9             'HTTP_BAD_REQUEST' => 400,
10 7     7   61 };
  7         16  
11              
12 7     7   55 use Carp ();
  7         15  
  7         150  
13 7     7   3470 use Dancer2::Plugin;
  7         85981  
  7         63  
14 7     7   25071 use Scalar::Util ();
  7         20  
  7         157  
15 7     7   39 use Ref::Util qw< is_ref is_arrayref >;
  7         16  
  7         9230  
16              
17             plugin_keywords(qw);
18              
19             has 'type_checks' => (
20             'is' => 'ro',
21             'default' => sub { +{} },
22             );
23              
24             has 'type_actions' => (
25             'is' => 'ro',
26             'builder' => '_build_type_actions',
27             );
28              
29             sub _build_type_actions {
30 7     7   19429 my $self = shift;
31 7         33 Scalar::Util::weaken( my $plugin = $self );
32             return {
33             'error' => sub {
34 7     7   20 my ( $self, $details ) = @_;
35 7         17 my ( $type, $name ) = @{$details}{qw};
  7         21  
36              
37 7         44 $plugin->dsl->send_error(
38             "Parameter $name must be $type",
39             HTTP_BAD_REQUEST(),
40             );
41             },
42              
43             'missing' => sub {
44 6     6   23 my ( $self, $details ) = @_;
45 6         15 my ( $name, $type ) = @{$details}{qw};
  6         20  
46              
47 6         41 $self->dsl->send_error(
48             "Missing parameter: $name ($type)",
49             HTTP_BAD_REQUEST(),
50             );
51             },
52 7         175 };
53             }
54              
55             sub register_type_check {
56 7     7 1 727 my ( $self, $name, $cb ) = @_;
57 7         50 $self->type_checks->{$name} = $cb;
58 7         25 return;
59             }
60              
61             sub register_type_action {
62 1     1 1 12 my ( $self, $name, $cb ) = @_;
63 1         5 $self->type_actions->{$name} = $cb;
64 1         3 return;
65             }
66              
67             sub with_types {
68 8     8 1 227 my ( $self, $full_type_details, $cb ) = @_;
69 8         24 my %params_to_check;
70              
71 8 50       37 is_arrayref($full_type_details)
72             or Carp::croak('Input for with_types must be arrayref');
73              
74             ## no critic qw(ControlStructures::ProhibitCStyleForLoops)
75 8         24 for ( my $idx = 0; $idx <= $#{$full_type_details}; $idx++ ) {
  17         98  
76 9         25 my $item = $full_type_details->[$idx];
77 9 50       40 my ( $is_optional, $type_details )
    100          
78             = is_arrayref($item) ? ( 0, $item )
79             : $item eq 'optional' ? ( 1, $full_type_details->[ ++$idx ] )
80             : Carp::croak("Unsupported type option: $item");
81              
82 9         20 my ( $sources, $name, $type, $action ) = @{$type_details};
  9         29  
83              
84 9         40 @{$type_details} == ARGS_NUM_BASIC() ||
85 9 50 66     17 @{$type_details} == ARGS_NUM_OPTIONAL()
  1         6  
86             or Carp::croak("Incorrect number of elements for type ($name)");
87              
88             # default action
89 9 100 66     43 defined $action && length $action
90             or $action = 'error';
91              
92 9 100       29 if ( is_ref($sources) ) {
93 1 50       4 is_arrayref($sources)
94 0         0 or Carp::croak("Source cannot be of @{[ ref $sources ]}");
95              
96 1 50       2 @{$sources} > 0
  1         4  
97             or Carp::croak('You must provide at least one source');
98             } else {
99 8         20 $sources = [$sources];
100             }
101              
102 9         18 foreach my $src ( @{$sources} ) {
  9         25  
103 10 50 100     82 $src eq 'route' || $src eq 'query' || $src eq 'body'
      66        
104             or Carp::croak("Type $name provided from unknown source '$src'");
105             }
106              
107 9 50       54 defined $self->type_checks->{$type}
108             or Carp::croak("Type $name provided unknown type '$type'");
109              
110 9 50       45 defined $self->type_actions->{$action}
111             or
112             Carp::croak("Type $name provided unknown action '$action'");
113              
114 9 50       36 defined $self->type_actions->{'missing'}
115             or Carp::croak('You need to provide a "missing" action');
116              
117 9         20 my $src = join ':', sort @{$sources};
  9         37  
118 9         89 $params_to_check{$src}{$name} = {
119             'optional' => $is_optional,
120             'source' => $src,
121             'name' => $name,
122             'type' => $type,
123             'action' => $action,
124             };
125             }
126              
127             # Couldn't prove yet that this is required, but it makes sense to me
128 8         47 Scalar::Util::weaken( my $plugin = $self );
129              
130             return sub {
131 25     25   1201926 my @route_args = @_;
132              
133             # Hash::MultiValue has "each" method which we could use to
134             # traverse it in the opposite direction (for each parameter sent
135             # we find the appropriate value and check it), but that could
136             # possibly introduce an attack vector of sending a lot of
137             # parameters to force longer loops. For now, the loop is based
138             # on how many parameters to added to be checked, which is a known
139             # set. (GET has a max limit, PUT/POST...?) -- SX
140              
141             # Only check if anything was supplied
142 25         112 foreach my $source ( keys %params_to_check ) {
143 25         53 foreach my $name ( keys %{ $params_to_check{$source} } ) {
  25         89  
144 28         130 my @sources = split /:/xms, $source;
145 28         76 my $details = $params_to_check{$source}{$name};
146              
147 28 100       89 if ( @sources == 1 ) {
148             $plugin->run_check($details)
149             or
150 22 100       98 $self->type_actions->{'missing'}->( $self, $details );
151             } else {
152 6         10 my $found;
153 6         13 foreach my $single_source (@sources) {
154 10         24 $details->{'source'} = $single_source;
155 10 100       26 if ( $plugin->run_check($details) ) {
156 2         8 $found++;
157 2         6 last;
158             }
159             }
160              
161             $found
162             or
163 4 100       24 $self->type_actions->{'missing'}->( $self, $details );
164             }
165             }
166             }
167              
168 11         44 $cb->(@route_args);
169 8         86 };
170             }
171              
172             sub run_check {
173 32     32 0 78 my ( $self, $details ) = @_;
174              
175             my ( $source, $name, $type, $action, $optional )
176 32         61 = @{$details}{qw};
  32         142  
177              
178 32         130 my $app = $self->app;
179 32         75 my $request = $app->request;
180              
181 32 100       188 my $params
    100          
182             = $source eq 'route' ? $request->route_parameters
183             : $source eq 'query' ? $request->query_parameters
184             : $request->body_parameters;
185              
186             # No parameter value, is this okay or not?
187 32 100       3050 if ( !exists $params->{$name} ) {
188             # It's okay, ignore
189 11 100       78 $optional
190             and return 1;
191              
192             # Not okay, missing when it's required!
193 10         65 return;
194             }
195              
196 21         82 my @param_values = $params->get_all($name);
197 21         413 my $check_cb = $self->type_checks->{$type};
198              
199 21         53 foreach my $param_value (@param_values) {
200 23 100       133 if ( ! $check_cb->($param_value) ) {
201             my $action_cb
202 8         74 = $self->type_actions->{$action};
203              
204 8         33 return $action_cb->( $self, $details );
205             }
206             }
207              
208 13         130 return 1;
209             }
210              
211             1;
212              
213             __END__