lib/CatalystX/Declare/Action/CatchValidationError.pm

   1 use MooseX::Declare;
   2
   3 role CatalystX::Declare::Action::CatchValidationError {
   4
   5     use MooseX::Types::Moose qw( ArrayRef Str HashRef );
   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
  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
  26     has controller_instance => (
  27         is          => 'rw',
  28         isa         => 'Catalyst::Controller',
  29         weak_ref    => 1,
  30     );
  31
  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
  41                 my $value = $ctx->request->params->{ $key };
  42                 my $tc    = $tcs->{ $key };
  43
  44                 if ($tc and $tc->is_subtype_of(ArrayRef)) {
  45
  46                     $value = []
  47                         unless exists $ctx->request->params->{ $key };
  48
  49                     $value = [$value]
  50                         unless is_ArrayRef $value;
  51                 }
  52                 else {
  53
  54                     next unless exists $ctx->request->params->{ $key };
  55                 }
  56
  57                 $extracted{ $key } = $value;
  58             }
  59         }
  60
  61         return \%extracted;
  62     }
  63
  64     around execute (Object $ctrl, Object $ctx, @rest) {
  65
  66         return $self->$orig($ctrl, $ctx, @rest, %{ $self->extract_named_params($ctx) });
  67     }
  68
  69     around match (Object $ctx) {
  70
  71         return
  72             unless $self->$orig($ctx);
  73         return 1
  74             unless $self->method_type_constraint;
  75
  76         my @args    = ($self->controller_instance, $ctx, @{ $ctx->req->args });
  77         my $tc      = $self->method_type_constraint;
  78         my $np      = $self->extract_named_params($ctx);
  79         my $ret     = $tc->_type_constraint->check([\@args, $np]);
  80
  81         return $ret;
  82     }
  83 }