refactored value string building
[catagits/Reaction.git] / lib / Reaction / UI / ViewPort / Field.pm
1 package Reaction::UI::ViewPort::Field;
2
3 use Reaction::Class;
4 use aliased 'Reaction::InterfaceModel::Object';
5 use aliased 'Reaction::Meta::InterfaceModel::Object::ParameterAttribute';
6
7 class Field is 'Reaction::UI::ViewPort', which {
8
9   has value        => (is => 'rw', lazy_build => 1, clearer => 'clear_value');
10   has name         => (is => 'rw', isa => 'Str', lazy_build => 1);
11   has label        => (is => 'rw', isa => 'Str', lazy_build => 1);
12   has value_string => (is => 'rw', isa => 'Str', lazy_build => 1);
13
14   has model     => (is => 'ro', isa => Object,             required => 1);
15   has attribute => (is => 'ro', isa => ParameterAttribute, required => 1);
16
17   implements adopt_value => as {};
18
19   implements _build_name => as { shift->attribute->name };
20
21   implements _build_label => as {
22     join(' ', map { ucfirst } split('_', shift->name));
23   };
24
25   implements _build_value => as {
26     my ($self) = @_;
27     my $reader = $self->attribute->get_read_method;
28     return $self->model->$reader;
29   };
30
31   implements _model_has_value => as {
32     my ($self) = @_;
33     my $predicate = $self->attribute->predicate;
34
35     if (!$predicate || $self->model->$predicate
36         || ($self->attribute->is_lazy
37             && !$self->attribute->is_lazy_fail)
38       ) {
39       # either model attribute has a value now or can build it
40       return 1;
41     }
42     return 0;
43   };
44
45   implements _build_value_string => as {
46     my ($self) = @_;
47     # XXX need the defined test because the IM lazy builds from
48     # the model and DBIC can have nullable fields and DBIC doesn't
49     # have a way to tell us that doesn't force value inflation (extra
50     # SELECTs for belongs_to) so basically we're screwed.
51     return ($self->_model_has_value && defined($self->value)
52               ? $self->_value_string_from_value
53               : $self->_empty_string_value);
54   };
55
56   implements _value_string_from_value => as {
57     shift->value;
58   };
59
60   implements _empty_string_value => as { '' };
61
62 };
63
64 1;
65 __END__;
66
67 =head1 NAME
68
69 Reaction::UI::ViewPort::Field
70
71 =head1 DESCRIPTION
72
73 =head1 ATTRIBUTES
74
75 =head2 model
76
77 =head2 attribute
78
79 =head2 value
80
81 =head2 name
82
83 =head2 label
84
85 =head2 value_string
86
87 =head1 AUTHORS
88
89 See L<Reaction::Class> for authors.
90
91 =head1 LICENSE
92
93 See L<Reaction::Class> for the license.
94
95 =cut