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