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