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