Commit | Line | Data |
7adfd53f |
1 | package Reaction::UI::ViewPort::ObjectView; |
2 | |
3 | use Reaction::Class; |
4 | |
5 | use aliased 'Reaction::UI::ViewPort::DisplayField::Text'; |
6 | use aliased 'Reaction::UI::ViewPort::DisplayField::Number'; |
7 | use aliased 'Reaction::UI::ViewPort::DisplayField::Boolean'; |
8 | use aliased 'Reaction::UI::ViewPort::DisplayField::String'; |
9 | use aliased 'Reaction::UI::ViewPort::DisplayField::DateTime'; |
10 | use aliased 'Reaction::UI::ViewPort::DisplayField::RelatedObject'; |
11 | use aliased 'Reaction::UI::ViewPort::DisplayField::List'; |
12 | use aliased 'Reaction::UI::ViewPort::DisplayField::Collection'; |
13 | |
14 | class ObjectView is 'Reaction::UI::ViewPort', which { |
15 | has object => ( |
16 | isa => 'Reaction::InterfaceModel::Object', is => 'ro', required => 1 |
17 | ); |
18 | |
7adfd53f |
19 | has _field_map => ( |
7b78a39d |
20 | isa => 'HashRef', is => 'rw', init_arg => 'fields', lazy_build => 1, |
7adfd53f |
21 | ); |
22 | |
23 | has exclude_fields => |
24 | ( is => 'rw', isa => 'ArrayRef', required => 1, default => sub{ [] } ); |
25 | |
7b78a39d |
26 | has ordered_fields => (is => 'rw', isa => 'ArrayRef', lazy_build => 1); |
27 | |
7b78a39d |
28 | implements fields => as { shift->_field_map }; |
7adfd53f |
29 | |
30 | implements BUILD => as { |
31 | my ($self, $args) = @_; |
32 | unless ($self->_has_field_map) { |
33 | my @field_map; |
34 | my $object = $self->object; |
35 | my %excluded = map{$_ => 1} @{$self->exclude_fields}; |
36 | for my $attr (grep { !$excluded{$_->name} } $object->parameter_attributes) { |
37 | push(@field_map, $self->build_fields_for($attr => $args)); |
38 | } |
39 | |
6ab43711 |
40 | my %field_map = @field_map; |
41 | $self->_field_map( \%field_map ); |
7adfd53f |
42 | } |
43 | }; |
44 | |
45 | implements build_fields_for => as { |
46 | my ($self, $attr, $args) = @_; |
47 | my $attr_name = $attr->name; |
48 | my $builder = "build_fields_for_name_${attr_name}"; |
49 | my @fields; |
50 | if ($self->can($builder)) { |
51 | @fields = $self->$builder($attr, $args); # re-use coderef from can() |
52 | } elsif ($attr->has_type_constraint) { |
53 | my $constraint = $attr->type_constraint; |
54 | my $base_name = $constraint->name; |
55 | my $tried_isa = 0; |
56 | CONSTRAINT: while (defined($constraint)) { |
57 | my $name = $constraint->name; |
58 | if (eval { $name->can('meta') } && !$tried_isa++) { |
59 | foreach my $class ($name->meta->class_precedence_list) { |
60 | my $mangled_name = $class; |
61 | $mangled_name =~ s/:+/_/g; |
62 | my $builder = "build_fields_for_type_${mangled_name}"; |
63 | if ($self->can($builder)) { |
64 | @fields = $self->$builder($attr, $args); |
65 | last CONSTRAINT; |
66 | } |
67 | } |
68 | } |
69 | if (defined($name)) { |
70 | unless (defined($base_name)) { |
71 | $base_name = "(anon subtype of ${name})"; |
72 | } |
73 | my $mangled_name = $name; |
74 | $mangled_name =~ s/:+/_/g; |
75 | my $builder = "build_fields_for_type_${mangled_name}"; |
76 | if ($self->can($builder)) { |
77 | @fields = $self->$builder($attr, $args); |
78 | last CONSTRAINT; |
79 | } |
80 | } |
81 | $constraint = $constraint->parent; |
82 | } |
83 | if (!defined($constraint)) { |
84 | 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"; |
85 | } |
86 | } else { |
87 | confess "Can't build field ${attr} without $builder method or type constraint"; |
88 | } |
89 | return @fields; |
90 | }; |
91 | |
7b78a39d |
92 | implements _build_field_map => as { |
7adfd53f |
93 | confess "Lazy field map building not supported by default"; |
94 | }; |
95 | |
7b78a39d |
96 | implements build_ordered_fields => as { |
97 | my $self = shift; |
6ab43711 |
98 | my $ordered = $self->sort_by_spec($self->column_order, [keys %{$self->_field_map}]); |
99 | return [@{$self->_field_map}{@$ordered}]; |
7b78a39d |
100 | }; |
101 | |
7adfd53f |
102 | implements build_simple_field => as { |
103 | my ($self, $class, $attr, $args) = @_; |
104 | my $attr_name = $attr->name; |
105 | my %extra; |
106 | if (my $config = $args->{Field}{$attr_name}) { |
107 | %extra = %$config; |
108 | } |
109 | my $field = $class->new( |
110 | object => $self->object, |
111 | attribute => $attr, |
112 | name => $attr->name, |
113 | location => join('-', $self->location, 'field', $attr->name), |
114 | ctx => $self->ctx, |
115 | %extra |
116 | ); |
117 | return ($attr_name => $field); |
118 | }; |
119 | |
120 | implements build_fields_for_type_Num => as { |
121 | my ($self, $attr, $args) = @_; |
122 | return $self->build_simple_field(Number, $attr, $args); |
123 | }; |
124 | |
125 | implements build_fields_for_type_Int => as { |
126 | my ($self, $attr, $args) = @_; |
127 | return $self->build_simple_field(Number, $attr, $args); |
128 | }; |
129 | |
130 | implements build_fields_for_type_Bool => as { |
131 | my ($self, $attr, $args) = @_; |
132 | return $self->build_simple_field(Boolean, $attr, $args); |
133 | }; |
134 | |
135 | implements build_fields_for_type_Password => as { return }; |
136 | |
137 | implements build_fields_for_type_Str => as { |
138 | my ($self, $attr, $args) = @_; |
139 | return $self->build_simple_field(String, $attr, $args); |
140 | }; |
141 | |
142 | implements build_fields_for_type_SimpleStr => as { |
143 | my ($self, $attr, $args) = @_; |
144 | return $self->build_simple_field(String, $attr, $args); |
145 | }; |
146 | |
147 | implements build_fields_for_type_DateTime => as { |
148 | my ($self, $attr, $args) = @_; |
149 | return $self->build_simple_field(DateTime, $attr, $args); |
150 | }; |
151 | |
152 | implements build_fields_for_type_Enum => as { |
153 | my ($self, $attr, $args) = @_; |
154 | return $self->build_simple_field(String, $attr, $args); |
155 | }; |
156 | |
7adfd53f |
157 | implements build_fields_for_type_ArrayRef => as { |
158 | my ($self, $attr, $args) = @_; |
159 | return $self->build_simple_field(List, $attr, $args) |
160 | }; |
161 | |
f670cfd0 |
162 | implements build_fields_for_type_Reaction_InterfaceModel_Collection => as { |
7adfd53f |
163 | my ($self, $attr, $args) = @_; |
164 | return $self->build_simple_field(Collection, $attr, $args) |
165 | }; |
166 | |
167 | implements build_fields_for_type_Reaction_InterfaceModel_Object => as { |
168 | my ($self, $attr, $args) = @_; |
169 | return $self->build_simple_field(RelatedObject, $attr, $args); |
170 | }; |
171 | |
7adfd53f |
172 | no Moose; |
173 | |
174 | no strict 'refs'; |
175 | delete ${__PACKAGE__ . '::'}{inner}; |
176 | |
177 | }; |
178 | |
179 | 1; |