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