Commit | Line | Data |
ddccc6a2 |
1 | package Reaction::UI::ViewPort::Object; |
2 | |
3 | use Reaction::Class; |
4 | |
5 | use aliased 'Reaction::UI::ViewPort::Field::Text'; |
6 | use aliased 'Reaction::UI::ViewPort::Field::Number'; |
7 | use aliased 'Reaction::UI::ViewPort::Field::Integer'; |
8 | use aliased 'Reaction::UI::ViewPort::Field::Boolean'; |
9 | use aliased 'Reaction::UI::ViewPort::Field::String'; |
10 | use aliased 'Reaction::UI::ViewPort::Field::DateTime'; |
11 | use aliased 'Reaction::UI::ViewPort::Field::RelatedObject'; |
c8fbb8ad |
12 | use aliased 'Reaction::UI::ViewPort::Field::Array'; |
ddccc6a2 |
13 | use aliased 'Reaction::UI::ViewPort::Field::Collection'; |
4ed8c1eb |
14 | use aliased 'Reaction::UI::ViewPort::Field::File'; |
599c1172 |
15 | use aliased 'Reaction::UI::ViewPort::Field::Container'; |
ddccc6a2 |
16 | |
17 | use aliased 'Reaction::InterfaceModel::Object' => 'IM_Object'; |
18 | |
7b5e71ad |
19 | use MooseX::Types::Moose qw/ArrayRef HashRef/; |
20 | |
81393881 |
21 | use namespace::clean -except => [ qw(meta) ]; |
22 | extends 'Reaction::UI::ViewPort'; |
ddccc6a2 |
23 | |
d738d11f |
24 | with 'Reaction::UI::ViewPort::Role::Actions'; |
25 | |
81393881 |
26 | #everything is read only right now. Later I can make somethings read-write |
27 | #but first I need to figure out what depends on what so we can have decent triggers |
28 | has model => (is => 'ro', isa => IM_Object, required => 1); |
7b5e71ad |
29 | has fields => (is => 'ro', isa => ArrayRef, lazy_build => 1); |
ddccc6a2 |
30 | |
81393881 |
31 | has field_args => (is => 'rw'); |
7b5e71ad |
32 | has field_order => (is => 'ro', isa => ArrayRef); |
81393881 |
33 | |
7b5e71ad |
34 | has builder_cache => (is => 'ro', isa => HashRef, lazy_build => 1); |
35 | has excluded_fields => (is => 'ro', isa => ArrayRef, lazy_build => 1); |
36 | has included_fields => (is => 'ro', isa => ArrayRef, lazy_build => 1); |
37 | has computed_field_order => (is => 'ro', isa => ArrayRef, lazy_build => 1); |
599c1172 |
38 | |
7b5e71ad |
39 | has containers => ( is => 'ro', isa => ArrayRef, lazy_build => 1); |
40 | has container_layouts => ( is => 'rw', isa => ArrayRef ); |
599c1172 |
41 | |
81393881 |
42 | sub BUILD { |
43 | my ($self, $args) = @_; |
44 | if( my $field_args = delete $args->{Field} ){ |
45 | $self->field_args( $field_args ); |
46 | } |
b343a983 |
47 | } |
48 | |
49 | sub _build_builder_cache { {} } |
50 | sub _build_excluded_fields { [] } |
f5e2ab69 |
51 | sub _build_included_fields { [] } |
b343a983 |
52 | |
53 | sub _build_containers { |
54 | my $self = shift; |
55 | |
56 | my @container_layouts; |
57 | if( $self->has_container_layouts ){ |
58 | #make sure we don't accidentally modify the original |
59 | @container_layouts = map { {%$_} }@{ $self->container_layouts }; |
60 | } #we should always have a '_' container; |
61 | unless (grep {$_->{name} eq '_'} @container_layouts ){ |
62 | unshift(@container_layouts, {name => '_'}); |
63 | } |
64 | |
65 | my %fields; |
66 | my $ordered_field_names = $self->computed_field_order; |
67 | @fields{ @$ordered_field_names } = @{ $self->fields }; |
68 | |
69 | my %containers; |
70 | my @container_order; |
71 | for my $layout ( @container_layouts ){ |
72 | my @container_fields; |
73 | my $name = $layout->{name}; |
74 | push(@container_order, $name); |
75 | if( my $field_names = delete $layout->{fields} ){ |
76 | map{ push(@container_fields, $_) } grep { defined } |
77 | map { delete $fields{$_} } @$field_names; |
78 | } |
79 | $containers{$name} = Container->new( |
80 | ctx => $self->ctx, |
81 | location => join( '-', $self->location, 'container', $name ), |
82 | fields => \@container_fields, |
83 | %$layout, |
84 | ); |
85 | } |
86 | if( keys %fields ){ |
87 | my @leftovers = grep { exists $fields{$_} } @$ordered_field_names; |
88 | push(@{ $containers{_}->fields }, @fields{@leftovers} ); |
89 | } |
90 | |
91 | #only return containers with at least one field |
92 | return [ grep { scalar(@{ $_->fields }) } @containers{@container_order} ]; |
93 | } |
114916fc |
94 | |
81393881 |
95 | sub _build_fields { |
96 | my ($self) = @_; |
97 | my $obj = $self->model; |
98 | my $args = $self->has_field_args ? $self->field_args : {}; |
99 | my @fields; |
371430b4 |
100 | my %param_attrs = map { $_->name => $_ } $obj->parameter_attributes; |
81393881 |
101 | for my $field_name (@{ $self->computed_field_order }) { |
371430b4 |
102 | my $attr = $param_attrs{$field_name}; |
81393881 |
103 | my $meth = $self->builder_cache->{$field_name} ||= $self->get_builder_for($attr); |
104 | my $field = $self->$meth($attr, ($args->{$field_name} || {})); |
599c1172 |
105 | next unless $field; |
106 | push(@fields, $field); |
81393881 |
107 | } |
108 | return \@fields; |
599c1172 |
109 | } |
114916fc |
110 | |
81393881 |
111 | sub _build_computed_field_order { |
112 | my ($self) = @_; |
113 | my %excluded = map { $_ => undef } @{ $self->excluded_fields }; |
f5e2ab69 |
114 | my %included = map { $_ => undef } @{ $self->included_fields }; |
81393881 |
115 | #treat _$field_name as private and exclude fields with no reader |
f5e2ab69 |
116 | my @names = grep { $_ !~ /^_/ && (!%included || exists( $included{$_}) ) |
117 | && !exists($excluded{$_}) } map { $_->name } |
81393881 |
118 | grep { defined $_->get_read_method } $self->model->parameter_attributes; |
119 | return $self->sort_by_spec($self->field_order || [], \@names); |
599c1172 |
120 | } |
81393881 |
121 | |
122 | override child_event_sinks => sub { |
123 | return ( @{shift->fields}, super()); |
124 | }; |
125 | |
126 | #candidate for shared role! |
127 | sub get_builder_for { |
128 | my ($self, $attr) = @_; |
129 | my $attr_name = $attr->name; |
130 | my $builder = "_build_fields_for_name_${attr_name}"; |
131 | return $builder if $self->can($builder); |
132 | if ($attr->has_type_constraint) { |
133 | my $constraint = $attr->type_constraint; |
134 | my $base_name = $constraint->name; |
135 | my $tried_isa = 0; |
136 | my @tried; |
137 | CONSTRAINT: while (defined($constraint)) { |
138 | my $name = $constraint->name; |
139 | $name = $attr->_isa_metadata if($name eq '__ANON__'); |
140 | if (eval { $name->can('meta') } && !$tried_isa++) { |
141 | foreach my $class ($name->meta->class_precedence_list) { |
142 | push(@tried, $class); |
143 | my $mangled_name = $class; |
ddccc6a2 |
144 | $mangled_name =~ s/:+/_/g; |
145 | my $builder = "_build_fields_for_type_${mangled_name}"; |
146 | return $builder if $self->can($builder); |
147 | } |
ddccc6a2 |
148 | } |
81393881 |
149 | if (defined($name)) { |
150 | push(@tried, $name); |
151 | unless (defined($base_name)) { |
152 | $base_name = "(anon subtype of ${name})"; |
153 | } |
154 | my $mangled_name = $name; |
155 | $mangled_name =~ s/:+/_/g; |
156 | my $builder = "_build_fields_for_type_${mangled_name}"; |
157 | return $builder if $self->can($builder); |
ddccc6a2 |
158 | } |
81393881 |
159 | $constraint = $constraint->parent; |
ddccc6a2 |
160 | } |
81393881 |
161 | if (!defined($constraint)) { |
162 | confess "Can't build field ${attr_name} of type ${base_name} without " |
163 | ."$builder method or _build_fields_for_type_<type> method " |
164 | ."for type or any supertype (tried ".join(', ', @tried).")"; |
165 | } |
166 | } else { |
167 | confess "Can't build field ${attr} without $builder method or type constraint"; |
168 | } |
599c1172 |
169 | } |
170 | |
81393881 |
171 | sub _build_simple_field { |
172 | my ($self, %args) = @_; |
173 | my $class = delete $args{class}; |
174 | confess("Can not build simple field without a viewport class") |
175 | unless $class; |
176 | confess("Can not build simple field without attribute") |
177 | unless defined $args{attribute}; |
178 | |
179 | my $field_name = $args{attribute}->name; |
180 | return $class->new( |
487c3208 |
181 | ctx => $self->ctx, |
182 | model => $self->model, |
183 | location => join('-', $self->location, 'field', $field_name), |
184 | %args |
185 | ); |
599c1172 |
186 | } |
187 | |
81393881 |
188 | sub _build_fields_for_type_Num { |
189 | my ($self, $attr, $args) = @_; |
190 | $self->_build_simple_field(attribute => $attr, class => Number, %$args); |
599c1172 |
191 | } |
192 | |
81393881 |
193 | sub _build_fields_for_type_Int { |
194 | my ($self, $attr, $args) = @_; |
ddccc6a2 |
195 | #XXX |
81393881 |
196 | $self->_build_simple_field(attribute => $attr, class => Integer, %$args); |
599c1172 |
197 | } |
198 | |
81393881 |
199 | sub _build_fields_for_type_Bool { |
200 | my ($self, $attr, $args) = @_; |
201 | $self->_build_simple_field(attribute => $attr, class => Boolean, %$args); |
599c1172 |
202 | } |
ddccc6a2 |
203 | |
81393881 |
204 | #XXX |
205 | sub _build_fields_for_type_Reaction_Types_Core_Password { return }; |
114916fc |
206 | |
81393881 |
207 | sub _build_fields_for_type_Str { |
208 | my ($self, $attr, $args) = @_; |
209 | #XXX |
210 | $self->_build_simple_field(attribute => $attr, class => String, %$args); |
599c1172 |
211 | } |
212 | |
81393881 |
213 | sub _build_fields_for_type_Reaction_Types_Core_SimpleStr { |
214 | my ($self, $attr, $args) = @_; |
215 | $self->_build_simple_field(attribute => $attr, class => String, %$args); |
599c1172 |
216 | } |
217 | |
81393881 |
218 | sub _build_fields_for_type_Reaction_Types_DateTime_DateTime { |
219 | my ($self, $attr, $args) = @_; |
220 | $self->_build_simple_field(attribute => $attr, class => DateTime, %$args); |
599c1172 |
221 | } |
222 | |
81393881 |
223 | sub _build_fields_for_type_Enum { |
224 | my ($self, $attr, $args) = @_; |
225 | #XXX |
226 | $self->_build_simple_field(attribute => $attr, class => String, %$args); |
599c1172 |
227 | } |
228 | |
81393881 |
229 | sub _build_fields_for_type_ArrayRef { |
230 | my ($self, $attr, $args) = @_; |
231 | $self->_build_simple_field(attribute => $attr, class => Array, %$args); |
599c1172 |
232 | } |
233 | |
81393881 |
234 | sub _build_fields_for_type_Reaction_Types_File_File { |
235 | my ($self, $attr, $args) = @_; |
236 | $self->_build_simple_field(attribute => $attr, class => File, %$args); |
599c1172 |
237 | } |
238 | |
81393881 |
239 | sub _build_fields_for_type_Reaction_InterfaceModel_Object { |
240 | my ($self, $attr, $args) = @_; |
241 | #XXX |
242 | $self->_build_simple_field(attribute => $attr, class => RelatedObject, %$args); |
599c1172 |
243 | } |
244 | |
81393881 |
245 | sub _build_fields_for_type_Reaction_InterfaceModel_Collection { |
246 | my ($self, $attr, $args) = @_; |
247 | $self->_build_simple_field(attribute => $attr, class => Collection, %$args); |
599c1172 |
248 | } |
81393881 |
249 | |
baee102d |
250 | sub _build_fields_for_type_MooseX_Types_Common_String_SimpleStr { |
251 | my ($self, $attr, $args) = @_; |
252 | $self->_build_simple_field(attribute => $attr, class => String, %$args); |
253 | } |
254 | |
255 | sub _build_fields_for_type_MooseX_Types_Common_String_Password { |
256 | return; |
257 | } |
258 | |
259 | sub _build_fields_for_type_MooseX_Types_DateTime_DateTime { |
260 | my ($self, $attr, $args) = @_; |
261 | $self->_build_simple_field(attribute => $attr, class => DateTime, %$args); |
262 | } |
263 | |
264 | sub _build_fields_for_type_DateTime { |
265 | my ($self, $attr, $args) = @_; |
266 | $self->_build_simple_field(attribute => $attr, class => DateTime, %$args); |
267 | } |
268 | |
81393881 |
269 | __PACKAGE__->meta->make_immutable; |
270 | |
ddccc6a2 |
271 | 1; |
2dba7201 |
272 | |
273 | __END__; |
274 | |
275 | =head1 NAME |
276 | |
63bb30b4 |
277 | Reaction::UI::ViewPort::Object - Display an InterfaceModel::Object |
278 | |
279 | =head1 SYNOPSIS |
280 | |
281 | use aliased 'Reaction::UI::ViewPort::Object'; |
282 | |
283 | ... |
284 | $controller->push_viewport(Object, |
285 | model => $person_interface_model_object, |
286 | fields_order => [qw( firstname lastname )], |
287 | excluded_fields => [qw( password )], |
288 | ); |
2dba7201 |
289 | |
290 | =head1 DESCRIPTION |
291 | |
63bb30b4 |
292 | Takes a L<Reaction::InterfaceModel::Object> class and displays the |
293 | configured fields. |
294 | |
2dba7201 |
295 | =head1 ATTRIBUTES |
296 | |
297 | =head2 model |
298 | |
63bb30b4 |
299 | Required L<Reaction::InterfaceModel::Object>. |
300 | |
2dba7201 |
301 | =head2 fields |
302 | |
63bb30b4 |
303 | Initialised via L</_build_fields> |
304 | |
2dba7201 |
305 | =head2 field_args |
306 | |
63bb30b4 |
307 | Hash reference keyed by field names. Values are hash references containing |
308 | arguments to the field builder method of the attribute. |
309 | |
2dba7201 |
310 | =head2 field_order |
311 | |
63bb30b4 |
312 | Array reference of strings defining the order of all fields (including |
313 | the ones that might be excluded). |
314 | |
2dba7201 |
315 | =head2 builder_cache |
316 | |
63bb30b4 |
317 | Hash reference containing resolved builder method names per field. Utilised |
318 | by L</_build_fields> |
319 | |
2dba7201 |
320 | =head2 excluded_fields |
321 | |
63bb30b4 |
322 | Array reference of strings naming fields to exclude from the interface. |
f5e2ab69 |
323 | |
324 | =head2 included_fields |
325 | |
326 | List of field names to include. If both C<included_fields> and |
327 | C<excluded_fields> are specified the result is those fields which |
328 | are in C<included_fields> and not in C<excluded_fields>. |
329 | |
2dba7201 |
330 | =head2 computed_field_order |
331 | |
63bb30b4 |
332 | Array reference of strings Initialised by the L</_computed_field_order> method. |
333 | Contains the fields to show in the correct order. |
334 | |
335 | =head2 containers |
336 | |
337 | Array reference populated by L</_build_containers>. |
338 | |
339 | =head2 container_layouts |
340 | |
341 | Array reference containing container layout specifications. |
342 | |
2dba7201 |
343 | =head1 INTERNAL METHODS |
344 | |
345 | These methods, although stable, are subject to change without notice. These are meant |
346 | to be used only by developers. End users should refrain from using these methods to |
347 | avoid potential breakages. |
348 | |
349 | =head2 BUILD |
350 | |
63bb30b4 |
351 | Takes the value of the C<Field> constructor argument, if true, and sets it as |
352 | the new L</field_args> hash reference. |
353 | |
2dba7201 |
354 | =head2 get_builder_for |
355 | |
63bb30b4 |
356 | Takes an attribute object as argument and returns a string containing |
357 | the name of the method that builds the fields for this attribute. |
358 | |
359 | If the viewport implements it, C<_build_fields_for_name_${attr_name}> will be used. |
360 | |
361 | If that is not available, it will take the C<isa> information of the type constraint |
362 | and see if it is a loaded class implementing C<meta>. If it is, every class in its |
363 | C<class_precedence_list> will be taken and used to try to find a |
364 | C<_build_fields_for_type_${mangled_class_name}> method on the viewport. |
365 | |
366 | "mangled" means here that every C<:*> will be replaced with C<_>. For example: |
367 | C<Foo::Bar> would become C<Foo_Bar>. |
368 | |
369 | If the C<isa> information was not obtainable or no fitting method was found, it will |
370 | try the type name in a method named C<_build_fields_for_type_${mangled_type_name}>. |
371 | |
372 | If could be found on this constraint, it will make the same attempts to find a |
373 | method on its parent type constraint. |
374 | |
375 | This method will die if it can't locate a method to build a field for this |
376 | attribute. |
377 | |
378 | =head2 _build_containers |
379 | |
380 | Uses L</container_layouts> to build a list of L<Reaction::UI::ViewPort::Field::Container> |
381 | objects. |
382 | |
383 | =head2 _build_fields |
384 | |
385 | Takes the L</model>s C<parameter_attributes> to build fields via L</get_builder_for>. |
386 | They will be ordered as specified in L</computed_field_order>. |
387 | |
388 | =head2 _build_computed_field_order |
389 | |
390 | Takes the names of the L</model>s C<parameter_attributes>' reader methods and assumes |
391 | them as field names. Then it uses L</field_order> and L</excluded_fields> to calculate |
392 | the order of all included fields and returns those names. |
393 | |
2dba7201 |
394 | =head2 _build_simple_field |
395 | |
63bb30b4 |
396 | $self->_build_simple_field( |
397 | attribute => $attribute_object, |
398 | class => $field_class, |
399 | %field_attrs, |
400 | ); |
401 | |
402 | Takes an attribute meta object, a field class (a L<Reaction::UI::ViewPort::Field> subclass) |
403 | and an additional set of arguments to pass to the field constructor and returns the new |
404 | field. Field classes themselves are L<Reaction::UI::ViewPort> subclasses. |
405 | |
2dba7201 |
406 | =head2 _build_fields_for_type_Num |
407 | |
408 | =head2 _build_fields_for_type_Int |
409 | |
410 | =head2 _build_fields_for_type_Bool |
411 | |
412 | =head2 _build_fields_for_type_Password |
413 | |
414 | =head2 _build_fields_for_type_Str |
415 | |
416 | =head2 _build_fields_for_type_SimpleStr |
417 | |
418 | =head2 _build_fields_for_type_DateTime |
419 | |
420 | =head2 _build_fields_for_type_Enum |
421 | |
422 | =head2 _build_fields_for_type_ArrayRef |
423 | |
424 | =head2 _build_fields_for_type_Reaction_InterfaceModel_Object |
425 | |
426 | =head2 _build_fields_for_type_Reaction_InterfaceModel_Collection |
427 | |
63bb30b4 |
428 | =head1 FIELD TYPES |
429 | |
430 | L<Text|Reaction::UI::ViewPort::Field::Text>, |
431 | L<Number|Reaction::UI::ViewPort::Field::Number>, |
432 | L<Integer|Reaction::UI::ViewPort::Field::Integer>, |
433 | L<Boolean|Reaction::UI::ViewPort::Field::Boolean>, |
434 | L<String|Reaction::UI::ViewPort::Field::String>, |
435 | L<DateTime|Reaction::UI::ViewPort::Field::DateTime>, |
436 | L<RelatedObject|Reaction::UI::ViewPort::Field::RelatedObject>, |
437 | L<Array|Reaction::UI::ViewPort::Field::Array>, |
438 | L<Collection|Reaction::UI::ViewPort::Field::Collection>, |
439 | L<File|Reaction::UI::ViewPort::Field::File>, |
440 | L<Container|Reaction::UI::ViewPort::Field::Container> |
441 | |
2dba7201 |
442 | =head1 AUTHORS |
443 | |
444 | See L<Reaction::Class> for authors. |
445 | |
446 | =head1 LICENSE |
447 | |
448 | See L<Reaction::Class> for the license. |
449 | |
450 | =cut |