1 package Reaction::UI::ViewPort::Object;
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';
12 use aliased 'Reaction::UI::ViewPort::Field::Array';
13 use aliased 'Reaction::UI::ViewPort::Field::Collection';
14 use aliased 'Reaction::UI::ViewPort::Field::File';
15 use aliased 'Reaction::UI::ViewPort::Field::Container';
17 use aliased 'Reaction::InterfaceModel::Object' => 'IM_Object';
19 use namespace::clean -except => [ qw(meta) ];
20 extends 'Reaction::UI::ViewPort';
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);
27 has field_args => (is => 'rw');
28 has field_order => (is => 'ro', isa => 'ArrayRef');
30 has builder_cache => (is => 'ro', isa => 'HashRef', lazy_build => 1);
31 has excluded_fields => (is => 'ro', isa => 'ArrayRef', lazy_build => 1);
32 has computed_field_order => (is => 'ro', isa => 'ArrayRef', lazy_build => 1);
34 has containers => ( is => 'ro', isa => 'ArrayRef', lazy_build => 1);
35 has container_layouts => ( is => 'rw', isa => 'ArrayRef' );
38 my ($self, $args) = @_;
39 if( my $field_args = delete $args->{Field} ){
40 $self->field_args( $field_args );
44 sub _build_builder_cache { {} }
45 sub _build_excluded_fields { [] }
47 sub _build_containers {
50 my @container_layouts;
51 if( $self->has_container_layouts ){
52 #make sure we don't accidentally modify the original
53 @container_layouts = map { {%$_} }@{ $self->container_layouts };
54 } #we should always have a '_' container;
55 unless (grep {$_->{name} eq '_'} @container_layouts ){
56 unshift(@container_layouts, {name => '_'});
60 my $ordered_field_names = $self->computed_field_order;
61 @fields{ @$ordered_field_names } = @{ $self->fields };
65 for my $layout ( @container_layouts ){
67 my $name = $layout->{name};
68 push(@container_order, $name);
69 if( my $field_names = delete $layout->{fields} ){
70 map{ push(@container_fields, $_) } grep { defined }
71 map { delete $fields{$_} } @$field_names;
73 $containers{$name} = Container->new(
75 location => join( '-', $self->location, 'container', $name ),
76 fields => \@container_fields,
81 my @leftovers = grep { exists $fields{$_} } @$ordered_field_names;
82 push(@{ $containers{_}->fields }, @fields{@leftovers} );
85 #only return containers with at least one field
86 return [ grep { scalar(@{ $_->fields }) } @containers{@container_order} ];
91 my $obj = $self->model;
92 my $args = $self->has_field_args ? $self->field_args : {};
94 my %param_attrs = map { $_->name => $_ } $obj->parameter_attributes;
95 for my $field_name (@{ $self->computed_field_order }) {
96 my $attr = $param_attrs{$field_name};
97 my $meth = $self->builder_cache->{$field_name} ||= $self->get_builder_for($attr);
98 my $field = $self->$meth($attr, ($args->{$field_name} || {}));
100 push(@fields, $field);
105 sub _build_computed_field_order {
107 my %excluded = map { $_ => undef } @{ $self->excluded_fields };
108 #treat _$field_name as private and exclude fields with no reader
109 my @names = grep { $_ !~ /^_/ && !exists($excluded{$_})} map { $_->name }
110 grep { defined $_->get_read_method } $self->model->parameter_attributes;
111 return $self->sort_by_spec($self->field_order || [], \@names);
114 override child_event_sinks => sub {
115 return ( @{shift->fields}, super());
118 #candidate for shared role!
119 sub get_builder_for {
120 my ($self, $attr) = @_;
121 my $attr_name = $attr->name;
122 my $builder = "_build_fields_for_name_${attr_name}";
123 return $builder if $self->can($builder);
124 if ($attr->has_type_constraint) {
125 my $constraint = $attr->type_constraint;
126 my $base_name = $constraint->name;
129 CONSTRAINT: while (defined($constraint)) {
130 my $name = $constraint->name;
131 $name = $attr->_isa_metadata if($name eq '__ANON__');
132 if (eval { $name->can('meta') } && !$tried_isa++) {
133 foreach my $class ($name->meta->class_precedence_list) {
134 push(@tried, $class);
135 my $mangled_name = $class;
136 $mangled_name =~ s/:+/_/g;
137 my $builder = "_build_fields_for_type_${mangled_name}";
138 return $builder if $self->can($builder);
141 if (defined($name)) {
143 unless (defined($base_name)) {
144 $base_name = "(anon subtype of ${name})";
146 my $mangled_name = $name;
147 $mangled_name =~ s/:+/_/g;
148 my $builder = "_build_fields_for_type_${mangled_name}";
149 return $builder if $self->can($builder);
151 $constraint = $constraint->parent;
153 if (!defined($constraint)) {
154 confess "Can't build field ${attr_name} of type ${base_name} without "
155 ."$builder method or _build_fields_for_type_<type> method "
156 ."for type or any supertype (tried ".join(', ', @tried).")";
159 confess "Can't build field ${attr} without $builder method or type constraint";
163 sub _build_simple_field {
164 my ($self, %args) = @_;
165 my $class = delete $args{class};
166 confess("Can not build simple field without a viewport class")
168 confess("Can not build simple field without attribute")
169 unless defined $args{attribute};
171 my $field_name = $args{attribute}->name;
174 model => $self->model,
175 location => join('-', $self->location, 'field', $field_name),
180 sub _build_fields_for_type_Num {
181 my ($self, $attr, $args) = @_;
182 $self->_build_simple_field(attribute => $attr, class => Number, %$args);
185 sub _build_fields_for_type_Int {
186 my ($self, $attr, $args) = @_;
188 $self->_build_simple_field(attribute => $attr, class => Integer, %$args);
191 sub _build_fields_for_type_Bool {
192 my ($self, $attr, $args) = @_;
193 $self->_build_simple_field(attribute => $attr, class => Boolean, %$args);
197 sub _build_fields_for_type_Reaction_Types_Core_Password { return };
199 sub _build_fields_for_type_Str {
200 my ($self, $attr, $args) = @_;
202 $self->_build_simple_field(attribute => $attr, class => String, %$args);
205 sub _build_fields_for_type_Reaction_Types_Core_SimpleStr {
206 my ($self, $attr, $args) = @_;
207 $self->_build_simple_field(attribute => $attr, class => String, %$args);
210 sub _build_fields_for_type_Reaction_Types_DateTime_DateTime {
211 my ($self, $attr, $args) = @_;
212 $self->_build_simple_field(attribute => $attr, class => DateTime, %$args);
215 sub _build_fields_for_type_Enum {
216 my ($self, $attr, $args) = @_;
218 $self->_build_simple_field(attribute => $attr, class => String, %$args);
221 sub _build_fields_for_type_ArrayRef {
222 my ($self, $attr, $args) = @_;
223 $self->_build_simple_field(attribute => $attr, class => Array, %$args);
226 sub _build_fields_for_type_Reaction_Types_File_File {
227 my ($self, $attr, $args) = @_;
228 $self->_build_simple_field(attribute => $attr, class => File, %$args);
231 sub _build_fields_for_type_Reaction_InterfaceModel_Object {
232 my ($self, $attr, $args) = @_;
234 $self->_build_simple_field(attribute => $attr, class => RelatedObject, %$args);
237 sub _build_fields_for_type_Reaction_InterfaceModel_Collection {
238 my ($self, $attr, $args) = @_;
239 $self->_build_simple_field(attribute => $attr, class => Collection, %$args);
242 __PACKAGE__->meta->make_immutable;
250 Reaction::UI::ViewPort::Object
266 =head2 excluded_fields
268 =head2 computed_field_order
270 =head1 INTERNAL METHODS
272 These methods, although stable, are subject to change without notice. These are meant
273 to be used only by developers. End users should refrain from using these methods to
274 avoid potential breakages.
278 =head2 get_builder_for
280 =head2 _build_simple_field
282 =head2 _build_fields_for_type_Num
284 =head2 _build_fields_for_type_Int
286 =head2 _build_fields_for_type_Bool
288 =head2 _build_fields_for_type_Password
290 =head2 _build_fields_for_type_Str
292 =head2 _build_fields_for_type_SimpleStr
294 =head2 _build_fields_for_type_DateTime
296 =head2 _build_fields_for_type_Enum
298 =head2 _build_fields_for_type_ArrayRef
300 =head2 _build_fields_for_type_Reaction_InterfaceModel_Object
302 =head2 _build_fields_for_type_Reaction_InterfaceModel_Collection
306 See L<Reaction::Class> for authors.
310 See L<Reaction::Class> for the license.