Commit | Line | Data |
5fb5cef1 |
1 | use MooseX::Declare; |
2 | |
3 | role CatalystX::Declare::Action::CatchValidationError { |
4 | |
accfac7d |
5 | use MooseX::Types::Moose qw( ArrayRef Str HashRef ); |
ed4a2203 |
6 | use aliased 'Moose::Meta::TypeConstraint'; |
7 | |
8 | has method_type_constraint => ( |
9 | is => 'rw', |
10 | isa => TypeConstraint, |
11 | handles => { |
12 | _check_action_arguments => 'check', |
13 | }, |
14 | ); |
15 | |
accfac7d |
16 | has method_named_params => ( |
17 | is => 'rw', |
18 | isa => ArrayRef[Str], |
19 | ); |
20 | |
21 | has method_named_type_constraint => ( |
22 | is => 'rw', |
23 | isa => HashRef[TypeConstraint], |
24 | ); |
25 | |
ed4a2203 |
26 | has controller_instance => ( |
27 | is => 'rw', |
28 | isa => 'Catalyst::Controller', |
29 | weak_ref => 1, |
30 | ); |
31 | |
accfac7d |
32 | method extract_named_params (Object $ctx) { |
33 | |
34 | my %extracted; |
35 | my $tcs = $self->method_named_type_constraint; |
36 | |
37 | if (my $named = $self->method_named_params) { |
38 | |
39 | for my $key (@$named) { |
40 | |
ef2b95b5 |
41 | next unless exists $ctx->request->params->{ $key }; |
42 | |
accfac7d |
43 | my $value = $ctx->request->params->{ $key }; |
44 | my $tc = $tcs->{ $key }; |
45 | |
46 | if ($tc and $tc->is_subtype_of(ArrayRef)) { |
47 | |
48 | $value = [] |
49 | unless exists $ctx->request->params->{ $key }; |
50 | |
51 | $value = [$value] |
52 | unless is_ArrayRef $value; |
53 | } |
54 | |
55 | $extracted{ $key } = $value; |
56 | } |
57 | } |
58 | |
59 | return \%extracted; |
60 | } |
61 | |
62 | around execute (Object $ctrl, Object $ctx, @rest) { |
63 | |
64 | return $self->$orig($ctrl, $ctx, @rest, %{ $self->extract_named_params($ctx) }); |
65 | } |
66 | |
ed4a2203 |
67 | around match (Object $ctx) { |
68 | |
69 | return |
70 | unless $self->$orig($ctx); |
71 | return 1 |
72 | unless $self->method_type_constraint; |
73 | |
74 | my @args = ($self->controller_instance, $ctx, @{ $ctx->req->args }); |
75 | my $tc = $self->method_type_constraint; |
accfac7d |
76 | my $np = $self->extract_named_params($ctx); |
77 | my $ret = $tc->_type_constraint->check([\@args, $np]); |
ed4a2203 |
78 | |
79 | return $ret; |
5fb5cef1 |
80 | } |
81 | } |