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