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