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'; |
14 | |
15 | use aliased 'Reaction::InterfaceModel::Object' => 'IM_Object'; |
16 | |
17 | class Object is 'Reaction::UI::ViewPort', which { |
18 | |
19 | #everything is read only right now. Later I can make somethings read-write |
20 | #but first I need to figure out what depends on what so we can have decent triggers |
21 | has model => (is => 'ro', isa => IM_Object, required => 1); |
22 | has fields => (is => 'ro', isa => 'ArrayRef', lazy_build => 1); |
23 | |
24 | has field_args => (is => 'ro'); |
25 | has field_order => (is => 'ro', isa => 'ArrayRef'); |
26 | |
27 | has builder_cache => (is => 'ro', isa => 'HashRef', lazy_build => 1); |
28 | has ordered_fields => (is => 'ro', isa => 'ArrayRef', lazy_build => 1); |
29 | has excluded_fields => (is => 'ro', isa => 'ArrayRef', lazy_build => 1); |
30 | |
31 | implements BUILD => as { |
32 | my ($self, $args) = @_; |
33 | my $field_args = delete $args->{Field}; |
34 | $self->field_args( $field_args ) if ref $field_args; |
35 | }; |
36 | |
37 | implements _build_excluded_fields => as { [] }; |
38 | implements _build_builder_cache => as { {} }; |
39 | |
40 | implements _build_fields => as { |
41 | my ($self) = @_; |
42 | my $obj = $self->model; |
43 | my $args = $self->has_field_args ? $self->field_args : {}; |
44 | my @fields; |
c03f75a7 |
45 | for my $field_name (@{ $self->ordered_fields }) { |
ddccc6a2 |
46 | my $attr = $obj->meta->find_attribute_by_name($field_name); |
47 | my $meth = $self->builder_cache->{$field_name} ||= $self->get_builder_for($attr); |
c03f75a7 |
48 | my $field = $self->$meth($attr, ($args->{$field_name} || {})); |
ddccc6a2 |
49 | push(@fields, $field) if $field; |
50 | } |
c8fbb8ad |
51 | return \@fields; |
ddccc6a2 |
52 | }; |
53 | |
54 | implements _build_ordered_fields => as { |
55 | my ($self) = @_; |
56 | my %excluded = map { $_ => undef } @{ $self->excluded_fields }; |
57 | #treat _$field_name as private and exclude fields with no reader |
c8fbb8ad |
58 | my @names = grep { $_ !~ /^_/ && !exists($excluded{$_})} map { $_->name } |
ddccc6a2 |
59 | grep { defined $_->get_read_method } $self->model->meta->parameter_attributes; |
c03f75a7 |
60 | return $self->sort_by_spec($self->field_order || [], \@names); |
ddccc6a2 |
61 | }; |
62 | |
63 | override child_event_sinks => sub { |
64 | return ( shift->fields, super()); |
65 | }; |
66 | |
67 | #candidate for shared role! |
68 | implements get_builder_for => as { |
69 | my ($self, $attr) = @_; |
70 | my $attr_name = $attr->name; |
71 | my $builder = "_build_fields_for_name_${attr_name}"; |
72 | return $builder if $self->can($builder); |
73 | if ($attr->has_type_constraint) { |
74 | my $constraint = $attr->type_constraint; |
75 | my $base_name = $constraint->name; |
76 | my $tried_isa = 0; |
77 | CONSTRAINT: while (defined($constraint)) { |
78 | my $name = $constraint->name; |
79 | $name = $attr->_isa_metadata if($name eq '__ANON__'); |
80 | if (eval { $name->can('meta') } && !$tried_isa++) { |
81 | foreach my $class ($name->meta->class_precedence_list) { |
82 | my $mangled_name = $class; |
83 | $mangled_name =~ s/:+/_/g; |
84 | my $builder = "_build_fields_for_type_${mangled_name}"; |
85 | return $builder if $self->can($builder); |
86 | } |
87 | } |
88 | if (defined($name)) { |
89 | unless (defined($base_name)) { |
90 | $base_name = "(anon subtype of ${name})"; |
91 | } |
92 | my $mangled_name = $name; |
93 | $mangled_name =~ s/:+/_/g; |
94 | my $builder = "_build_fields_for_type_${mangled_name}"; |
95 | return $builder if $self->can($builder); |
96 | } |
97 | $constraint = $constraint->parent; |
98 | } |
99 | if (!defined($constraint)) { |
100 | confess "Can't build field ${attr_name} of type ${base_name} without $builder method or _build_fields_for_type_<type> method for type or any supertype"; |
101 | } |
102 | } else { |
103 | confess "Can't build field ${attr} without $builder method or type constraint"; |
104 | } |
105 | }; |
106 | |
107 | implements _build_simple_field => as { |
108 | my ($self, %args) = @_; |
109 | my $class = delete $args{class}; |
110 | confess("Can not build simple field without a viewport class") |
111 | unless $class; |
112 | confess("Can not build simple field without attribute") |
113 | unless defined $args{attribute}; |
114 | |
115 | my $field_name = $args{attribute}->name; |
116 | return $class->new( |
117 | ctx => $self->ctx, |
118 | model => $self->model, |
119 | location => join('-', $self->location, 'field', $field_name), |
120 | %args |
121 | ); |
122 | }; |
123 | |
124 | implements _build_fields_for_type_Num => as { |
125 | my ($self, $attr, $args) = @_; |
126 | $self->_build_simple_field(attribute => $attr, class => Number, %$args); |
127 | }; |
128 | |
129 | implements _build_fields_for_type_Int => as { |
130 | my ($self, $attr, $args) = @_; |
131 | #XXX |
132 | $self->_build_simple_field(attribute => $attr, class => Integer, %$args); |
133 | }; |
134 | |
135 | implements _build_fields_for_type_Bool => as { |
136 | my ($self, $attr, $args) = @_; |
137 | $self->_build_simple_field(attribute => $attr, class => Boolean, %$args); |
138 | }; |
139 | |
140 | #XXX |
141 | implements _build_fields_for_type_Password => as { return }; |
142 | |
143 | implements _build_fields_for_type_Str => as { |
144 | my ($self, $attr, $args) = @_; |
145 | #XXX |
146 | $self->_build_simple_field(attribute => $attr, class => String, %$args); |
147 | }; |
148 | |
149 | implements _build_fields_for_type_SimpleStr => as { |
150 | my ($self, $attr, $args) = @_; |
151 | $self->_build_simple_field(attribute => $attr, class => String, %$args); |
152 | }; |
153 | |
154 | implements _build_fields_for_type_DateTime => as { |
155 | my ($self, $attr, $args) = @_; |
156 | $self->_build_simple_field(attribute => $attr, class => DateTime, %$args); |
157 | }; |
158 | |
159 | implements _build_fields_for_type_Enum => as { |
160 | my ($self, $attr, $args) = @_; |
161 | #XXX |
162 | $self->_build_simple_field(attribute => $attr, class => String, %$args); |
163 | }; |
164 | |
165 | implements _build_fields_for_type_ArrayRef => as { |
166 | my ($self, $attr, $args) = @_; |
c8fbb8ad |
167 | $self->_build_simple_field(attribute => $attr, class => Array, %$args); |
ddccc6a2 |
168 | }; |
169 | |
170 | implements _build_fields_for_type_Reaction_InterfaceModel_Object => as { |
171 | my ($self, $attr, $args) = @_; |
172 | #XXX |
173 | $self->_build_simple_field(attribute => $attr, class => RelatedObject, %$args); |
174 | }; |
175 | |
176 | implements _build_fields_for_type_Reaction_InterfaceModel_Collection => as { |
177 | my ($self, $attr, $args) = @_; |
178 | $self->_build_simple_field(attribute => $attr, class => Collection, %$args); |
179 | }; |
180 | |
181 | }; |
182 | |
183 | 1; |