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