lib/Reaction/UI/ViewPort/Object.pm

   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';
  12 use aliased 'Reaction::UI::ViewPort::Field::Array';
  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 excluded_fields => (is => 'ro', isa => 'ArrayRef', lazy_build => 1);
  29   has computed_field_order => (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;
  45     for my $field_name (@{ $self->computed_field_order }) {
  46       my $attr = $obj->meta->find_attribute_by_name($field_name);
  47       my $meth = $self->builder_cache->{$field_name} ||= $self->get_builder_for($attr);
  48       my $field = $self->$meth($attr, ($args->{$field_name} || {}));
  49       push(@fields, $field) if $field;
  50     }
  51     return \@fields;
  52   };
  53
  54   implements _build_computed_field_order => as {
  55     my ($self) = @_;
  56     my %excluded = map { $_ => undef } @{ $self->excluded_fields };
  57     #treat _$field_name as private and exclude fields with no reader
  58     my @names = grep { $_ !~ /^_/ && !exists($excluded{$_})} map { $_->name }
  59       grep { defined $_->get_read_method } $self->model->meta->parameter_attributes;
  60     return $self->sort_by_spec($self->field_order || [], \@names);
  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       my @tried;
  78     CONSTRAINT: while (defined($constraint)) {
  79         my $name = $constraint->name;
  80         $name = $attr->_isa_metadata if($name eq '__ANON__');
  81         if (eval { $name->can('meta') } && !$tried_isa++) {
  82           foreach my $class ($name->meta->class_precedence_list) {
  83             push(@tried, $class);
  84             my $mangled_name = $class;
  85             $mangled_name =~ s/:+/_/g;
  86             my $builder = "_build_fields_for_type_${mangled_name}";
  87             return $builder if $self->can($builder);
  88           }
  89         }
  90         if (defined($name)) {
  91           push(@tried, $name);
  92           unless (defined($base_name)) {
  93             $base_name = "(anon subtype of ${name})";
  94           }
  95           my $mangled_name = $name;
  96           $mangled_name =~ s/:+/_/g;
  97           my $builder = "_build_fields_for_type_${mangled_name}";
  98           return $builder if $self->can($builder);
  99         }
 100         $constraint = $constraint->parent;
 101       }
 102       if (!defined($constraint)) {
 103         confess "Can't build field ${attr_name} of type ${base_name} without "
 104                 ."$builder method or _build_fields_for_type_<type> method "
 105                 ."for type or any supertype (tried ".join(', ', @tried).")";
 106       }
 107     } else {
 108       confess "Can't build field ${attr} without $builder method or type constraint";
 109     }
 110   };
 111
 112   implements _build_simple_field => as {
 113     my ($self, %args) = @_;
 114     my $class = delete $args{class};
 115     confess("Can not build simple field without a viewport class")
 116       unless $class;
 117     confess("Can not build simple field without attribute")
 118       unless defined $args{attribute};
 119
 120     my $field_name = $args{attribute}->name;
 121     return $class->new(
 122                        ctx       => $self->ctx,
 123                        model     => $self->model,
 124                        location  => join('-', $self->location, 'field', $field_name),
 125                        %args
 126                       );
 127   };
 128
 129   implements _build_fields_for_type_Num => as {
 130     my ($self, $attr, $args) = @_;
 131     $self->_build_simple_field(attribute => $attr, class => Number, %$args);
 132   };
 133
 134   implements _build_fields_for_type_Int => as {
 135     my ($self, $attr, $args) = @_;
 136     #XXX
 137     $self->_build_simple_field(attribute => $attr, class => Integer, %$args);
 138   };
 139
 140   implements _build_fields_for_type_Bool => as {
 141     my ($self,  $attr, $args) = @_;
 142     $self->_build_simple_field(attribute => $attr, class => Boolean, %$args);
 143   };
 144
 145   #XXX
 146   implements _build_fields_for_type_Password => as { return };
 147
 148   implements _build_fields_for_type_Str => as {
 149     my ($self, $attr, $args) = @_;
 150     #XXX
 151     $self->_build_simple_field(attribute => $attr, class => String, %$args);
 152   };
 153
 154   implements _build_fields_for_type_SimpleStr => as {
 155     my ($self, $attr, $args) = @_;
 156     $self->_build_simple_field(attribute => $attr, class => String, %$args);
 157   };
 158
 159   implements _build_fields_for_type_DateTime => as {
 160     my ($self, $attr, $args) = @_;
 161     $self->_build_simple_field(attribute => $attr, class => DateTime, %$args);
 162   };
 163
 164   implements _build_fields_for_type_Enum => as {
 165     my ($self, $attr, $args) = @_;
 166     #XXX
 167     $self->_build_simple_field(attribute => $attr, class => String, %$args);
 168   };
 169
 170   implements _build_fields_for_type_ArrayRef => as {
 171     my ($self, $attr, $args) = @_;
 172     $self->_build_simple_field(attribute => $attr, class => Array, %$args);
 173   };
 174
 175   implements _build_fields_for_type_Reaction_InterfaceModel_Object => as {
 176     my ($self, $attr, $args) = @_;
 177     #XXX
 178     $self->_build_simple_field(attribute => $attr, class => RelatedObject, %$args);
 179   };
 180
 181   implements _build_fields_for_type_Reaction_InterfaceModel_Collection => as {
 182     my ($self, $attr, $args) = @_;
 183     $self->_build_simple_field(attribute => $attr, class => Collection, %$args);
 184   };
 185
 186 };
 187
 188 1;
 189
 190 __END__;
 191
 192 =head1 NAME
 193
 194 Reaction::UI::ViewPort::Object
 195
 196 =head1 DESCRIPTION
 197
 198 =head1 ATTRIBUTES
 199
 200 =head2 model
 201
 202 =head2 fields
 203
 204 =head2 field_args
 205
 206 =head2 field_order
 207
 208 =head2 builder_cache
 209
 210 =head2 excluded_fields
 211
 212 =head2 computed_field_order
 213
 214 =head1 INTERNAL METHODS
 215
 216 These methods, although stable, are subject to change without notice. These are meant
 217 to be used only by developers. End users should refrain from using these methods to
 218 avoid potential breakages.
 219
 220 =head2 BUILD
 221
 222 =head2 get_builder_for
 223
 224 =head2 _build_simple_field
 225
 226 =head2 _build_fields_for_type_Num
 227
 228 =head2 _build_fields_for_type_Int
 229
 230 =head2 _build_fields_for_type_Bool
 231
 232 =head2 _build_fields_for_type_Password
 233
 234 =head2 _build_fields_for_type_Str
 235
 236 =head2 _build_fields_for_type_SimpleStr
 237
 238 =head2 _build_fields_for_type_DateTime
 239
 240 =head2 _build_fields_for_type_Enum
 241
 242 =head2 _build_fields_for_type_ArrayRef
 243
 244 =head2 _build_fields_for_type_Reaction_InterfaceModel_Object
 245
 246 =head2 _build_fields_for_type_Reaction_InterfaceModel_Collection
 247
 248 =head1 AUTHORS
 249
 250 See L<Reaction::Class> for authors.
 251
 252 =head1 LICENSE
 253
 254 See L<Reaction::Class> for the license.
 255
 256 =cut