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 use namespace::clean -except => [ qw(meta) ];
  19 extends 'Reaction::UI::ViewPort';
  20
  21
  22
  23 #everything is read only right now. Later I can make somethings read-write
  24 #but first I need to figure out what depends on what so we can have decent triggers
  25 has model  => (is => 'ro', isa => IM_Object, required => 1);
  26 has fields => (is => 'ro', isa => 'ArrayRef', lazy_build => 1);
  27
  28 has field_args    => (is => 'rw');
  29 has field_order   => (is => 'ro', isa => 'ArrayRef');
  30
  31 has builder_cache   => (is => 'ro', isa => 'HashRef',  lazy_build => 1);
  32 has excluded_fields => (is => 'ro', isa => 'ArrayRef', lazy_build => 1);
  33 has computed_field_order => (is => 'ro', isa => 'ArrayRef', lazy_build => 1);
  34 sub BUILD {
  35   my ($self, $args) = @_;
  36   if( my $field_args = delete $args->{Field} ){
  37     $self->field_args( $field_args );
  38   }
  39 };
  40 sub _build_excluded_fields { [] };
  41 sub _build_builder_cache { {} };
  42 sub _build_fields {
  43   my ($self) = @_;
  44   my $obj  = $self->model;
  45   my $args = $self->has_field_args ? $self->field_args : {};
  46   my @fields;
  47   my %param_attrs = map { $_->name => $_ } $obj->parameter_attributes;
  48   for my $field_name (@{ $self->computed_field_order }) {
  49     my $attr = $param_attrs{$field_name};
  50     my $meth = $self->builder_cache->{$field_name} ||= $self->get_builder_for($attr);
  51     my $field = $self->$meth($attr, ($args->{$field_name} || {}));
  52     push(@fields, $field) if $field;
  53   }
  54   return \@fields;
  55 };
  56 sub _build_computed_field_order {
  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->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 sub get_builder_for {
  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 sub _build_simple_field {
 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 sub _build_fields_for_type_Num {
 130   my ($self, $attr, $args) = @_;
 131   $self->_build_simple_field(attribute => $attr, class => Number, %$args);
 132 };
 133 sub _build_fields_for_type_Int {
 134   my ($self, $attr, $args) = @_;
 135   #XXX
 136   $self->_build_simple_field(attribute => $attr, class => Integer, %$args);
 137 };
 138 sub _build_fields_for_type_Bool {
 139   my ($self,  $attr, $args) = @_;
 140   $self->_build_simple_field(attribute => $attr, class => Boolean, %$args);
 141 };
 142
 143 #XXX
 144 sub _build_fields_for_type_Reaction_Types_Core_Password { return };
 145 sub _build_fields_for_type_Str {
 146   my ($self, $attr, $args) = @_;
 147   #XXX
 148   $self->_build_simple_field(attribute => $attr, class => String, %$args);
 149 };
 150 sub _build_fields_for_type_Reaction_Types_Core_SimpleStr {
 151   my ($self, $attr, $args) = @_;
 152   $self->_build_simple_field(attribute => $attr, class => String, %$args);
 153 };
 154 sub _build_fields_for_type_Reaction_Types_DateTime_DateTime {
 155   my ($self, $attr, $args) = @_;
 156   $self->_build_simple_field(attribute => $attr, class => DateTime, %$args);
 157 };
 158 sub _build_fields_for_type_Enum {
 159   my ($self, $attr, $args) = @_;
 160   #XXX
 161   $self->_build_simple_field(attribute => $attr, class => String, %$args);
 162 };
 163 sub _build_fields_for_type_ArrayRef {
 164   my ($self, $attr, $args) = @_;
 165   $self->_build_simple_field(attribute => $attr, class => Array, %$args);
 166 };
 167 sub _build_fields_for_type_Reaction_Types_File_File {
 168   my ($self, $attr, $args) = @_;
 169   $self->_build_simple_field(attribute => $attr, class => File, %$args);
 170 };
 171 sub _build_fields_for_type_Reaction_InterfaceModel_Object {
 172   my ($self, $attr, $args) = @_;
 173   #XXX
 174   $self->_build_simple_field(attribute => $attr, class => RelatedObject, %$args);
 175 };
 176 sub _build_fields_for_type_Reaction_InterfaceModel_Collection {
 177   my ($self, $attr, $args) = @_;
 178   $self->_build_simple_field(attribute => $attr, class => Collection, %$args);
 179 };
 180
 181 __PACKAGE__->meta->make_immutable;
 182
 183
 184 1;
 185
 186 __END__;
 187
 188 =head1 NAME
 189
 190 Reaction::UI::ViewPort::Object
 191
 192 =head1 DESCRIPTION
 193
 194 =head1 ATTRIBUTES
 195
 196 =head2 model
 197
 198 =head2 fields
 199
 200 =head2 field_args
 201
 202 =head2 field_order
 203
 204 =head2 builder_cache
 205
 206 =head2 excluded_fields
 207
 208 =head2 computed_field_order
 209
 210 =head1 INTERNAL METHODS
 211
 212 These methods, although stable, are subject to change without notice. These are meant
 213 to be used only by developers. End users should refrain from using these methods to
 214 avoid potential breakages.
 215
 216 =head2 BUILD
 217
 218 =head2 get_builder_for
 219
 220 =head2 _build_simple_field
 221
 222 =head2 _build_fields_for_type_Num
 223
 224 =head2 _build_fields_for_type_Int
 225
 226 =head2 _build_fields_for_type_Bool
 227
 228 =head2 _build_fields_for_type_Password
 229
 230 =head2 _build_fields_for_type_Str
 231
 232 =head2 _build_fields_for_type_SimpleStr
 233
 234 =head2 _build_fields_for_type_DateTime
 235
 236 =head2 _build_fields_for_type_Enum
 237
 238 =head2 _build_fields_for_type_ArrayRef
 239
 240 =head2 _build_fields_for_type_Reaction_InterfaceModel_Object
 241
 242 =head2 _build_fields_for_type_Reaction_InterfaceModel_Collection
 243
 244 =head1 AUTHORS
 245
 246 See L<Reaction::Class> for authors.
 247
 248 =head1 LICENSE
 249
 250 See L<Reaction::Class> for the license.
 251
 252 =cut