lib/Reaction/Meta/InterfaceModel/Action/ParameterAttribute.pm

   1 package Reaction::Meta::InterfaceModel::Action::ParameterAttribute;
   2
   3 use Reaction::Class;
   4 use Scalar::Util 'blessed';
   5
   6 use namespace::clean -except => [ qw(meta) ];
   7 extends 'Reaction::Meta::Attribute';
   8
   9
  10 has valid_values => (
  11   isa => 'CodeRef',
  12   is => 'rw',
  13   predicate => 'has_valid_values'
  14 );
  15 sub new {
  16   my $self = shift->SUPER::new(@_); # work around immutable
  17   if(!$self->has_valid_values and $self->has_type_constraint) {
  18     my $tc = $self->type_constraint;
  19     if($tc->isa('Moose::Meta::TypeConstraint::Enum')) {
  20       $self->valid_values(sub { $tc->values });
  21     }
  22   }
  23   return $self;
  24 }
  25
  26 sub check_valid_value {
  27   my ($self, $object, $value) = @_;
  28   confess "Can't check_valid_value when no valid_values set"
  29     unless $self->has_valid_values;
  30   confess join " - ", blessed($object), $self->name
  31     unless ref $self->valid_values;
  32   my $valid = $self->valid_values->($object, $self);
  33   if ($self->type_constraint
  34       && ($self->type_constraint->name eq 'ArrayRef'
  35           || $self->type_constraint->is_subtype_of('ArrayRef'))) {
  36     confess "Parameter type is array ref but passed value isn't"
  37       unless ref($value) eq 'ARRAY';
  38     return [ map { $self->_check_single_valid($valid => $_) } @$value ];
  39   } else {
  40     return $self->_check_single_valid($valid => $value);
  41   }
  42 };
  43 sub _check_single_valid {
  44   my ($self, $valid, $value) = @_;
  45   return undef unless defined($value);
  46   if (ref $valid eq 'ARRAY') {
  47     return $value if grep { $_ eq $value } @$valid;
  48   } else {
  49     $value = $value->ident_condition if blessed($value);
  50     return $valid->find($value);
  51   }
  52   return undef; # XXX this is an assumption that undef is never valid
  53 };
  54 sub all_valid_values {
  55   my ($self, $object) = @_;
  56   confess "Can't call all_valid_values on an attribute without valid_values"
  57     unless $self->has_valid_values;
  58   my $valid = $self->valid_values->($object, $self);
  59   return ((ref $valid eq 'ARRAY')
  60           ? @$valid
  61           : $valid->all);
  62 };
  63 sub valid_value_collection {
  64   my ($self, $object) = @_;
  65   confess "Can't call valid_value_collection on an attribute without valid_values"
  66     unless $self->has_valid_values;
  67   my $valid = $self->valid_values->($object, $self);
  68   confess "valid_values returned an arrayref, not a collection"
  69     if (ref $valid eq 'ARRAY');
  70   return $valid;
  71 };
  72
  73 __PACKAGE__->meta->make_immutable(inline_constructor => 0);
  74
  75
  76 1;
  77
  78 =head1 NAME
  79
  80 Reaction::Meta::InterfaceModel::Action::ParamterAttribute
  81
  82 =head1 DESCRIPTION
  83
  84 =head1 METHODS
  85
  86 =head2 new
  87
  88 =head2 valid_values
  89
  90 =head2 has_valid_values
  91
  92 =head2 check_valid_value
  93
  94 =head2 all_valid_values
  95
  96 =head2 valid_value_collection
  97
  98 =head2 reader
  99
 100 =head2 writer
 101
 102 =head1 SEE ALSO
 103
 104 L<Reaction::Meta::Attribute>
 105
 106 =head1 AUTHORS
 107
 108 See L<Reaction::Class> for authors.
 109
 110 =head1 LICENSE
 111
 112 See L<Reaction::Class> for the license.
 113
 114 =cut