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