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     my $field_args = delete $args->{Field};
  35     $self->field_args( $field_args ) if ref $field_args;
  36   };
  37
  38   implements _build_excluded_fields => as { [] };
  39   implements _build_builder_cache   => as { {} };
  40
  41   implements _build_fields => as {
  42     my ($self) = @_;
  43     my $obj  = $self->model;
  44     my $args = $self->has_field_args ? $self->field_args : {};
  45     my @fields;
  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;
  51     }
  52     return \@fields;
  53   };
  54
  55   implements _build_computed_field_order => as {
  56     my ($self) = @_;
  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);
  62   };
  63
  64   override child_event_sinks => sub {
  65     return ( @{shift->fields}, super());
  66   };
  67
  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;
  77       my $tried_isa = 0;
  78       my @tried;
  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) {
  84             push(@tried, $class);
  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);
  89           }
  90         }
  91         if (defined($name)) {
  92           push(@tried, $name);
  93           unless (defined($base_name)) {
  94             $base_name = "(anon subtype of ${name})";
  95           }
  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);
 100         }
 101         $constraint = $constraint->parent;
 102       }
 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).")";
 107       }
 108     } else {
 109       confess "Can't build field ${attr} without $builder method or type constraint";
 110     }
 111   };
 112
 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")
 117       unless $class;
 118     confess("Can not build simple field without attribute")
 119       unless defined $args{attribute};
 120
 121     my $field_name = $args{attribute}->name;
 122     return $class->new(
 123                        ctx       => $self->ctx,
 124                        model     => $self->model,
 125                        location  => join('-', $self->location, 'field', $field_name),
 126                        %args
 127                       );
 128   };
 129
 130   implements _build_fields_for_type_Num => as {
 131     my ($self, $attr, $args) = @_;
 132     $self->_build_simple_field(attribute => $attr, class => Number, %$args);
 133   };
 134
 135   implements _build_fields_for_type_Int => as {
 136     my ($self, $attr, $args) = @_;
 137     #XXX
 138     $self->_build_simple_field(attribute => $attr, class => Integer, %$args);
 139   };
 140
 141   implements _build_fields_for_type_Bool => as {
 142     my ($self,  $attr, $args) = @_;
 143     $self->_build_simple_field(attribute => $attr, class => Boolean, %$args);
 144   };
 145
 146   #XXX
 147   implements _build_fields_for_type_Reaction_Types_Core_Password => as { return };
 148
 149   implements _build_fields_for_type_Str => as {
 150     my ($self, $attr, $args) = @_;
 151     #XXX
 152     $self->_build_simple_field(attribute => $attr, class => String, %$args);
 153   };
 154
 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);
 158   };
 159
 160   implements _build_fields_for_type_DateTime => as {
 161     my ($self, $attr, $args) = @_;
 162     $self->_build_simple_field(attribute => $attr, class => DateTime, %$args);
 163   };
 164
 165   implements _build_fields_for_type_Enum => as {
 166     my ($self, $attr, $args) = @_;
 167     #XXX
 168     $self->_build_simple_field(attribute => $attr, class => String, %$args);
 169   };
 170
 171   implements _build_fields_for_type_ArrayRef => as {
 172     my ($self, $attr, $args) = @_;
 173     $self->_build_simple_field(attribute => $attr, class => Array, %$args);
 174   };
 175
 176   implements _build_fields_for_type_File => as {
 177     my ($self, $attr, $args) = @_;
 178     $self->_build_simple_field(attribute => $attr, class => File, %$args);
 179   };
 180
 181   implements _build_fields_for_type_Reaction_InterfaceModel_Object => as {
 182     my ($self, $attr, $args) = @_;
 183     #XXX
 184     $self->_build_simple_field(attribute => $attr, class => RelatedObject, %$args);
 185   };
 186
 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);
 190   };
 191
 192 };
 193
 194 1;
 195
 196 __END__;
 197
 198 =head1 NAME
 199
 200 Reaction::UI::ViewPort::Object
 201
 202 =head1 DESCRIPTION
 203
 204 =head1 ATTRIBUTES
 205
 206 =head2 model
 207
 208 =head2 fields
 209
 210 =head2 field_args
 211
 212 =head2 field_order
 213
 214 =head2 builder_cache
 215
 216 =head2 excluded_fields
 217
 218 =head2 computed_field_order
 219
 220 =head1 INTERNAL METHODS
 221
 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.
 225
 226 =head2 BUILD
 227
 228 =head2 get_builder_for
 229
 230 =head2 _build_simple_field
 231
 232 =head2 _build_fields_for_type_Num
 233
 234 =head2 _build_fields_for_type_Int
 235
 236 =head2 _build_fields_for_type_Bool
 237
 238 =head2 _build_fields_for_type_Password
 239
 240 =head2 _build_fields_for_type_Str
 241
 242 =head2 _build_fields_for_type_SimpleStr
 243
 244 =head2 _build_fields_for_type_DateTime
 245
 246 =head2 _build_fields_for_type_Enum
 247
 248 =head2 _build_fields_for_type_ArrayRef
 249
 250 =head2 _build_fields_for_type_Reaction_InterfaceModel_Object
 251
 252 =head2 _build_fields_for_type_Reaction_InterfaceModel_Collection
 253
 254 =head1 AUTHORS
 255
 256 See L<Reaction::Class> for authors.
 257
 258 =head1 LICENSE
 259
 260 See L<Reaction::Class> for the license.
 261
 262 =cut