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