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';
16 use aliased 'Reaction::InterfaceModel::Object' => 'IM_Object';
18 class Object is 'Reaction::UI::ViewPort', which {
20 #everything is read only right now. Later I can make somethings read-write
21 #but first I need to figure out what depends on what so we can have decent triggers
22 has model => (is => 'ro', isa => IM_Object, required => 1);
23 has fields => (is => 'ro', isa => 'ArrayRef', lazy_build => 1);
25 has field_args => (is => 'rw');
26 has field_order => (is => 'ro', isa => 'ArrayRef');
28 has builder_cache => (is => 'ro', isa => 'HashRef', lazy_build => 1);
29 has excluded_fields => (is => 'ro', isa => 'ArrayRef', lazy_build => 1);
30 has computed_field_order => (is => 'ro', isa => 'ArrayRef', lazy_build => 1);
32 implements BUILD => as {
33 my ($self, $args) = @_;
34 my $field_args = delete $args->{Field};
35 $self->field_args( $field_args ) if ref $field_args;
38 implements _build_excluded_fields => as { [] };
39 implements _build_builder_cache => as { {} };
41 implements _build_fields => as {
43 my $obj = $self->model;
44 my $args = $self->has_field_args ? $self->field_args : {};
46 for my $field_name (@{ $self->computed_field_order }) {
47 my $attr = $obj->meta->find_attribute_by_name($field_name);
48 my $meth = $self->builder_cache->{$field_name} ||= $self->get_builder_for($attr);
49 my $field = $self->$meth($attr, ($args->{$field_name} || {}));
50 push(@fields, $field) if $field;
55 implements _build_computed_field_order => as {
57 my %excluded = map { $_ => undef } @{ $self->excluded_fields };
58 #treat _$field_name as private and exclude fields with no reader
59 my @names = grep { $_ !~ /^_/ && !exists($excluded{$_})} map { $_->name }
60 grep { defined $_->get_read_method } $self->model->meta->parameter_attributes;
61 return $self->sort_by_spec($self->field_order || [], \@names);
64 override child_event_sinks => sub {
65 return ( @{shift->fields}, super());
68 #candidate for shared role!
69 implements get_builder_for => as {
70 my ($self, $attr) = @_;
71 my $attr_name = $attr->name;
72 my $builder = "_build_fields_for_name_${attr_name}";
73 return $builder if $self->can($builder);
74 if ($attr->has_type_constraint) {
75 my $constraint = $attr->type_constraint;
76 my $base_name = $constraint->name;
79 CONSTRAINT: while (defined($constraint)) {
80 my $name = $constraint->name;
81 $name = $attr->_isa_metadata if($name eq '__ANON__');
82 if (eval { $name->can('meta') } && !$tried_isa++) {
83 foreach my $class ($name->meta->class_precedence_list) {
85 my $mangled_name = $class;
86 $mangled_name =~ s/:+/_/g;
87 my $builder = "_build_fields_for_type_${mangled_name}";
88 return $builder if $self->can($builder);
93 unless (defined($base_name)) {
94 $base_name = "(anon subtype of ${name})";
96 my $mangled_name = $name;
97 $mangled_name =~ s/:+/_/g;
98 my $builder = "_build_fields_for_type_${mangled_name}";
99 return $builder if $self->can($builder);
101 $constraint = $constraint->parent;
103 if (!defined($constraint)) {
104 confess "Can't build field ${attr_name} of type ${base_name} without "
105 ."$builder method or _build_fields_for_type_<type> method "
106 ."for type or any supertype (tried ".join(', ', @tried).")";
109 confess "Can't build field ${attr} without $builder method or type constraint";
113 implements _build_simple_field => as {
114 my ($self, %args) = @_;
115 my $class = delete $args{class};
116 confess("Can not build simple field without a viewport class")
118 confess("Can not build simple field without attribute")
119 unless defined $args{attribute};
121 my $field_name = $args{attribute}->name;
124 model => $self->model,
125 location => join('-', $self->location, 'field', $field_name),
130 implements _build_fields_for_type_Num => as {
131 my ($self, $attr, $args) = @_;
132 $self->_build_simple_field(attribute => $attr, class => Number, %$args);
135 implements _build_fields_for_type_Int => as {
136 my ($self, $attr, $args) = @_;
138 $self->_build_simple_field(attribute => $attr, class => Integer, %$args);
141 implements _build_fields_for_type_Bool => as {
142 my ($self, $attr, $args) = @_;
143 $self->_build_simple_field(attribute => $attr, class => Boolean, %$args);
147 implements _build_fields_for_type_Reaction_Types_Core_Password => as { return };
149 implements _build_fields_for_type_Str => as {
150 my ($self, $attr, $args) = @_;
152 $self->_build_simple_field(attribute => $attr, class => String, %$args);
155 implements _build_fields_for_type_Reaction_Types_Core_SimpleStr => as {
156 my ($self, $attr, $args) = @_;
157 $self->_build_simple_field(attribute => $attr, class => String, %$args);
160 implements _build_fields_for_type_Reaction_Types_DateTime_DateTime => as {
161 my ($self, $attr, $args) = @_;
162 $self->_build_simple_field(attribute => $attr, class => DateTime, %$args);
165 implements _build_fields_for_type_Enum => as {
166 my ($self, $attr, $args) = @_;
168 $self->_build_simple_field(attribute => $attr, class => String, %$args);
171 implements _build_fields_for_type_ArrayRef => as {
172 my ($self, $attr, $args) = @_;
173 $self->_build_simple_field(attribute => $attr, class => Array, %$args);
176 implements _build_fields_for_type_File => as {
177 my ($self, $attr, $args) = @_;
178 $self->_build_simple_field(attribute => $attr, class => File, %$args);
181 implements _build_fields_for_type_Reaction_InterfaceModel_Object => as {
182 my ($self, $attr, $args) = @_;
184 $self->_build_simple_field(attribute => $attr, class => RelatedObject, %$args);
187 implements _build_fields_for_type_Reaction_InterfaceModel_Collection => as {
188 my ($self, $attr, $args) = @_;
189 $self->_build_simple_field(attribute => $attr, class => Collection, %$args);
200 Reaction::UI::ViewPort::Object
216 =head2 excluded_fields
218 =head2 computed_field_order
220 =head1 INTERNAL METHODS
222 These methods, although stable, are subject to change without notice. These are meant
223 to be used only by developers. End users should refrain from using these methods to
224 avoid potential breakages.
228 =head2 get_builder_for
230 =head2 _build_simple_field
232 =head2 _build_fields_for_type_Num
234 =head2 _build_fields_for_type_Int
236 =head2 _build_fields_for_type_Bool
238 =head2 _build_fields_for_type_Password
240 =head2 _build_fields_for_type_Str
242 =head2 _build_fields_for_type_SimpleStr
244 =head2 _build_fields_for_type_DateTime
246 =head2 _build_fields_for_type_Enum
248 =head2 _build_fields_for_type_ArrayRef
250 =head2 _build_fields_for_type_Reaction_InterfaceModel_Object
252 =head2 _build_fields_for_type_Reaction_InterfaceModel_Collection
256 See L<Reaction::Class> for authors.
260 See L<Reaction::Class> for the license.