first checkin tests fail everywhere but demo works. yay?
[catagits/Reaction.git] / lib / Reaction / UI / ViewPort / Field.pm
1 package Reaction::UI::ViewPort::Field;
2
3 use Reaction::Class;
4
5 class Field is 'Reaction::UI::ViewPort', which {
6
7   has name => (
8     isa => 'Str', is => 'rw', required => 1
9   );
10
11   has action => (
12     isa => 'Reaction::InterfaceModel::Action',
13     is => 'ro', required => 0, predicate => 'has_action',
14   );
15
16   has attribute => (
17     isa => 'Reaction::Meta::InterfaceModel::Action::ParameterAttribute',
18     is => 'ro', predicate => 'has_attribute',
19   );
20
21   has value => (
22     is => 'rw', lazy_build => 1, trigger_adopt('value'),
23     clearer => 'clear_value',
24   );
25
26   has needs_sync => (
27     isa => 'Int', is => 'rw', default => 0
28   );
29
30   has label => (isa => 'Str', is => 'rw', lazy_build => 1);
31
32   has message => (
33     isa => 'Str', is => 'rw', required => 1, default => sub { '' }
34   );
35
36   implements BUILD => as {
37     my ($self) = @_;
38     if (!$self->has_attribute != !$self->has_action) {
39       confess "Should have both action and attribute or neither";
40     }
41   };
42
43   implements build_label => as {
44     my ($self) = @_;
45     return join(' ', map { ucfirst } split('_', $self->name));
46   };
47
48   implements build_value => as {
49     my ($self) = @_;
50     if ($self->has_attribute) {
51       my $reader = $self->attribute->get_read_method;
52       my $predicate = $self->attribute->predicate;
53       if (!$predicate || $self->action->$predicate) {
54         return $self->action->$reader;
55       }
56     }
57     return '';
58   };
59
60   implements adopt_value => as {
61     my ($self) = @_;
62     $self->needs_sync(1) if $self->has_attribute;
63   };
64
65   implements sync_to_action => as {
66     my ($self) = @_;
67     return unless $self->needs_sync && $self->has_attribute && $self->has_value;
68     my $attr = $self->attribute;
69     if (my $tc = $attr->type_constraint) {
70       my $value = $self->value;
71       if ($tc->has_coercion) {
72         $value = $tc->coercion->coerce($value);
73       }
74       my $error = $tc->validate($self->value);
75       if (defined $error) {
76         $self->message($error);
77         return;
78       }
79     }
80     my $writer = $attr->get_write_method;
81     confess "No writer for attribute" unless defined($writer);
82     $self->action->$writer($self->value);
83     $self->needs_sync(0);
84   };
85
86   implements sync_from_action => as {
87     my ($self) = @_;
88     return unless !$self->needs_sync && $self->has_attribute;
89     $self->message($self->action->error_for($self->attribute)||'');
90   };
91
92   override accept_events => sub { ('value', super()) };
93
94 };
95
96 1;
97
98 =head1 NAME
99
100 Reaction::UI::ViewPort::Field
101
102 =head1 DESCRIPTION
103
104 This viewport is the base class for all field types.
105
106 =head1 ATTRIBUTES
107
108 =head2 name
109
110 =head2 action
111
112 L<Reaction::InterfaceModel::Action>
113
114 =head2 attribute
115
116 L<Reaction::Meta::InterfaceModel::Action::ParameterAttribute>
117
118 =head2 value
119
120 =head2 needs_sync
121
122 =head2 label
123
124 User friendly label, by default is based on the name.
125
126 =head2 message
127
128 Optional string relating to the field.
129
130 =head1 SEE ALSO
131
132 =head2 L<Reaction::UI::ViewPort>
133
134 =head2 L<Reaction::UI::ViewPort::DisplayField>
135
136 =head2 L<Reaction::UI::ViewPort::Field::Boolean>
137
138 =head2 L<Reaction::UI::ViewPort::Field::ChooseMany>
139
140 =head2 L<Reaction::UI::ViewPort::Field::ChooseOne>
141
142 =head2 L<Reaction::UI::ViewPort::Field::DateTime>
143
144 =head2 L<Reaction::UI::ViewPort::Field::File>
145
146 =head2 L<Reaction::UI::ViewPort::Field::HiddenArray>
147
148 =head2 L<Reaction::UI::ViewPort::Field::Number>
149
150 =head2 L<Reaction::UI::ViewPort::Field::Password>
151
152 =head2 L<Reaction::UI::ViewPort::Field::String>
153
154 =head2 L<Reaction::UI::ViewPort::Field::Text>
155
156 =head2 L<Reaction::UI::ViewPort::Field::TimeRange>
157
158 =head1 AUTHORS
159
160 See L<Reaction::Class> for authors.
161
162 =head1 LICENSE
163
164 See L<Reaction::Class> for the license.
165
166 =cut