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                 next unless exists $ctx->request->params->{ $key };
  42
  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
  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;
  76         my $np      = $self->extract_named_params($ctx);
  77         my $ret     = $tc->_type_constraint->check([\@args, $np]);
  78
  79         return $ret;
  80     }
  81 }