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'; |
ddccc6a2 |
15 | |
16 | use aliased 'Reaction::InterfaceModel::Object' => 'IM_Object'; |
17 | |
81393881 |
18 | use namespace::clean -except => [ qw(meta) ]; |
19 | extends 'Reaction::UI::ViewPort'; |
ddccc6a2 |
20 | |
81393881 |
21 | #everything is read only right now. Later I can make somethings read-write |
22 | #but first I need to figure out what depends on what so we can have decent triggers |
23 | has model => (is => 'ro', isa => IM_Object, required => 1); |
24 | has fields => (is => 'ro', isa => 'ArrayRef', lazy_build => 1); |
ddccc6a2 |
25 | |
81393881 |
26 | has field_args => (is => 'rw'); |
27 | has field_order => (is => 'ro', isa => 'ArrayRef'); |
28 | |
29 | has builder_cache => (is => 'ro', isa => 'HashRef', lazy_build => 1); |
30 | has excluded_fields => (is => 'ro', isa => 'ArrayRef', lazy_build => 1); |
31 | has computed_field_order => (is => 'ro', isa => 'ArrayRef', lazy_build => 1); |
32 | sub BUILD { |
33 | my ($self, $args) = @_; |
34 | if( my $field_args = delete $args->{Field} ){ |
35 | $self->field_args( $field_args ); |
36 | } |
37 | }; |
114916fc |
38 | |
81393881 |
39 | sub _build_excluded_fields { [] }; |
40 | sub _build_builder_cache { {} }; |
41 | sub _build_fields { |
42 | my ($self) = @_; |
43 | my $obj = $self->model; |
44 | my $args = $self->has_field_args ? $self->field_args : {}; |
45 | my @fields; |
78e1dcd2 |
46 | my %param_attrs = map { $_->name => $_ } $obj->parameter_attributes; |
81393881 |
47 | for my $field_name (@{ $self->computed_field_order }) { |
78e1dcd2 |
48 | my $attr = $param_attrs{$field_name}; |
81393881 |
49 | my $meth = $self->builder_cache->{$field_name} ||= $self->get_builder_for($attr); |
50 | my $field = $self->$meth($attr, ($args->{$field_name} || {})); |
51 | push(@fields, $field) if $field; |
52 | } |
53 | return \@fields; |
54 | }; |
114916fc |
55 | |
81393881 |
56 | sub _build_computed_field_order { |
57 | my ($self) = @_; |
58 | my %excluded = map { $_ => undef } @{ $self->excluded_fields }; |
59 | #treat _$field_name as private and exclude fields with no reader |
60 | my @names = grep { $_ !~ /^_/ && !exists($excluded{$_})} map { $_->name } |
61 | grep { defined $_->get_read_method } $self->model->parameter_attributes; |
62 | return $self->sort_by_spec($self->field_order || [], \@names); |
63 | }; |
64 | |
65 | override child_event_sinks => sub { |
66 | return ( @{shift->fields}, super()); |
67 | }; |
68 | |
69 | #candidate for shared role! |
70 | sub get_builder_for { |
71 | my ($self, $attr) = @_; |
72 | my $attr_name = $attr->name; |
73 | my $builder = "_build_fields_for_name_${attr_name}"; |
74 | return $builder if $self->can($builder); |
75 | if ($attr->has_type_constraint) { |
76 | my $constraint = $attr->type_constraint; |
77 | my $base_name = $constraint->name; |
78 | my $tried_isa = 0; |
79 | my @tried; |
80 | CONSTRAINT: while (defined($constraint)) { |
81 | my $name = $constraint->name; |
82 | $name = $attr->_isa_metadata if($name eq '__ANON__'); |
83 | if (eval { $name->can('meta') } && !$tried_isa++) { |
84 | foreach my $class ($name->meta->class_precedence_list) { |
85 | push(@tried, $class); |
86 | my $mangled_name = $class; |
ddccc6a2 |
87 | $mangled_name =~ s/:+/_/g; |
88 | my $builder = "_build_fields_for_type_${mangled_name}"; |
89 | return $builder if $self->can($builder); |
90 | } |
ddccc6a2 |
91 | } |
81393881 |
92 | if (defined($name)) { |
93 | push(@tried, $name); |
94 | unless (defined($base_name)) { |
95 | $base_name = "(anon subtype of ${name})"; |
96 | } |
97 | my $mangled_name = $name; |
98 | $mangled_name =~ s/:+/_/g; |
99 | my $builder = "_build_fields_for_type_${mangled_name}"; |
100 | return $builder if $self->can($builder); |
ddccc6a2 |
101 | } |
81393881 |
102 | $constraint = $constraint->parent; |
ddccc6a2 |
103 | } |
81393881 |
104 | if (!defined($constraint)) { |
105 | confess "Can't build field ${attr_name} of type ${base_name} without " |
106 | ."$builder method or _build_fields_for_type_<type> method " |
107 | ."for type or any supertype (tried ".join(', ', @tried).")"; |
108 | } |
109 | } else { |
110 | confess "Can't build field ${attr} without $builder method or type constraint"; |
111 | } |
112 | }; |
113 | sub _build_simple_field { |
114 | my ($self, %args) = @_; |
115 | my $class = delete $args{class}; |
116 | confess("Can not build simple field without a viewport class") |
117 | unless $class; |
118 | confess("Can not build simple field without attribute") |
119 | unless defined $args{attribute}; |
120 | |
121 | my $field_name = $args{attribute}->name; |
122 | return $class->new( |
123 | ctx => $self->ctx, |
124 | model => $self->model, |
125 | location => join('-', $self->location, 'field', $field_name), |
126 | %args |
127 | ); |
128 | }; |
129 | sub _build_fields_for_type_Num { |
130 | my ($self, $attr, $args) = @_; |
131 | $self->_build_simple_field(attribute => $attr, class => Number, %$args); |
132 | }; |
133 | sub _build_fields_for_type_Int { |
134 | my ($self, $attr, $args) = @_; |
ddccc6a2 |
135 | #XXX |
81393881 |
136 | $self->_build_simple_field(attribute => $attr, class => Integer, %$args); |
137 | }; |
138 | sub _build_fields_for_type_Bool { |
139 | my ($self, $attr, $args) = @_; |
140 | $self->_build_simple_field(attribute => $attr, class => Boolean, %$args); |
141 | }; |
ddccc6a2 |
142 | |
81393881 |
143 | #XXX |
144 | sub _build_fields_for_type_Reaction_Types_Core_Password { return }; |
114916fc |
145 | |
81393881 |
146 | sub _build_fields_for_type_Str { |
147 | my ($self, $attr, $args) = @_; |
148 | #XXX |
149 | $self->_build_simple_field(attribute => $attr, class => String, %$args); |
150 | }; |
151 | sub _build_fields_for_type_Reaction_Types_Core_SimpleStr { |
152 | my ($self, $attr, $args) = @_; |
153 | $self->_build_simple_field(attribute => $attr, class => String, %$args); |
154 | }; |
155 | sub _build_fields_for_type_Reaction_Types_DateTime_DateTime { |
156 | my ($self, $attr, $args) = @_; |
157 | $self->_build_simple_field(attribute => $attr, class => DateTime, %$args); |
158 | }; |
159 | sub _build_fields_for_type_Enum { |
160 | my ($self, $attr, $args) = @_; |
161 | #XXX |
162 | $self->_build_simple_field(attribute => $attr, class => String, %$args); |
ddccc6a2 |
163 | }; |
81393881 |
164 | sub _build_fields_for_type_ArrayRef { |
165 | my ($self, $attr, $args) = @_; |
166 | $self->_build_simple_field(attribute => $attr, class => Array, %$args); |
167 | }; |
168 | sub _build_fields_for_type_Reaction_Types_File_File { |
169 | my ($self, $attr, $args) = @_; |
170 | $self->_build_simple_field(attribute => $attr, class => File, %$args); |
171 | }; |
172 | sub _build_fields_for_type_Reaction_InterfaceModel_Object { |
173 | my ($self, $attr, $args) = @_; |
174 | #XXX |
175 | $self->_build_simple_field(attribute => $attr, class => RelatedObject, %$args); |
176 | }; |
177 | sub _build_fields_for_type_Reaction_InterfaceModel_Collection { |
178 | my ($self, $attr, $args) = @_; |
179 | $self->_build_simple_field(attribute => $attr, class => Collection, %$args); |
180 | }; |
181 | |
182 | __PACKAGE__->meta->make_immutable; |
183 | |
ddccc6a2 |
184 | |
185 | 1; |
2dba7201 |
186 | |
187 | __END__; |
188 | |
189 | =head1 NAME |
190 | |
191 | Reaction::UI::ViewPort::Object |
192 | |
193 | =head1 DESCRIPTION |
194 | |
195 | =head1 ATTRIBUTES |
196 | |
197 | =head2 model |
198 | |
199 | =head2 fields |
200 | |
201 | =head2 field_args |
202 | |
203 | =head2 field_order |
204 | |
205 | =head2 builder_cache |
206 | |
207 | =head2 excluded_fields |
208 | |
209 | =head2 computed_field_order |
210 | |
211 | =head1 INTERNAL METHODS |
212 | |
213 | These methods, although stable, are subject to change without notice. These are meant |
214 | to be used only by developers. End users should refrain from using these methods to |
215 | avoid potential breakages. |
216 | |
217 | =head2 BUILD |
218 | |
219 | =head2 get_builder_for |
220 | |
221 | =head2 _build_simple_field |
222 | |
223 | =head2 _build_fields_for_type_Num |
224 | |
225 | =head2 _build_fields_for_type_Int |
226 | |
227 | =head2 _build_fields_for_type_Bool |
228 | |
229 | =head2 _build_fields_for_type_Password |
230 | |
231 | =head2 _build_fields_for_type_Str |
232 | |
233 | =head2 _build_fields_for_type_SimpleStr |
234 | |
235 | =head2 _build_fields_for_type_DateTime |
236 | |
237 | =head2 _build_fields_for_type_Enum |
238 | |
239 | =head2 _build_fields_for_type_ArrayRef |
240 | |
241 | =head2 _build_fields_for_type_Reaction_InterfaceModel_Object |
242 | |
243 | =head2 _build_fields_for_type_Reaction_InterfaceModel_Collection |
244 | |
245 | =head1 AUTHORS |
246 | |
247 | See L<Reaction::Class> for authors. |
248 | |
249 | =head1 LICENSE |
250 | |
251 | See L<Reaction::Class> for the license. |
252 | |
253 | =cut |