lib/Reaction/UI/ViewPort/ObjectView.pm

   1 package Reaction::UI::ViewPort::ObjectView;
   2
   3 use Reaction::Class;
   4
   5 use aliased 'Reaction::UI::ViewPort::DisplayField::Text';
   6 use aliased 'Reaction::UI::ViewPort::DisplayField::Number';
   7 use aliased 'Reaction::UI::ViewPort::DisplayField::Boolean';
   8 use aliased 'Reaction::UI::ViewPort::DisplayField::String';
   9 use aliased 'Reaction::UI::ViewPort::DisplayField::DateTime';
  10 use aliased 'Reaction::UI::ViewPort::DisplayField::RelatedObject';
  11 use aliased 'Reaction::UI::ViewPort::DisplayField::List';
  12 use aliased 'Reaction::UI::ViewPort::DisplayField::Collection';
  13 use aliased 'Reaction::InterfaceModel::Object';
  14
  15
  16 class ObjectView is 'Reaction::UI::ViewPort', which {
  17   has object         => (isa => Object, is => 'ro', required => 1);
  18   has ordered_fields => (is => 'rw', isa => 'ArrayRef', lazy_build => 1);
  19
  20   has _field_map => (
  21     isa => 'HashRef', is => 'rw', init_arg => 'fields', lazy_build => 1,
  22   );
  23
  24   has exclude_fields =>
  25       ( is => 'rw', isa => 'ArrayRef', required => 1, default => sub{ [] } );
  26
  27
  28
  29   implements fields => as { shift->_field_map };
  30
  31   implements BUILD => as {
  32     my ($self, $args) = @_;
  33     unless ($self->_has_field_map) {
  34       my @field_map;
  35       my $object = $self->object;
  36       my %excluded = map{$_ => 1} @{$self->exclude_fields};
  37       for my $attr (grep { !$excluded{$_->name} } $object->parameter_attributes) {
  38         push(@field_map, $self->build_fields_for($attr => $args));
  39       }
  40
  41       my %field_map = @field_map;
  42       $self->_field_map( \%field_map );
  43     }
  44   };
  45
  46   implements build_fields_for => as {
  47     my ($self, $attr, $args) = @_;
  48     my $attr_name = $attr->name;
  49     my $builder = "build_fields_for_name_${attr_name}";
  50     my @fields;
  51     if ($self->can($builder)) {
  52       @fields = $self->$builder($attr, $args); # re-use coderef from can()
  53     } elsif ($attr->has_type_constraint) {
  54       my $constraint = $attr->type_constraint;
  55       my $base_name = $constraint->name;
  56       my $tried_isa = 0;
  57       CONSTRAINT: while (defined($constraint)) {
  58         my $name = $constraint->name;
  59         $name = $attr->_isa_metadata if($name eq '__ANON__');
  60         if (eval { $name->can('meta') } && !$tried_isa++) {
  61           foreach my $class ($name->meta->class_precedence_list) {
  62             my $mangled_name = $class;
  63             $mangled_name =~ s/:+/_/g;
  64             my $builder = "build_fields_for_type_${mangled_name}";
  65             if ($self->can($builder)) {
  66               @fields = $self->$builder($attr, $args);
  67               last CONSTRAINT;
  68             }
  69           }
  70         }
  71         if (defined($name)) {
  72           unless (defined($base_name)) {
  73             $base_name = "(anon subtype of ${name})";
  74           }
  75           my $mangled_name = $name;
  76           $mangled_name =~ s/:+/_/g;
  77           my $builder = "build_fields_for_type_${mangled_name}";
  78           if ($self->can($builder)) {
  79             @fields = $self->$builder($attr, $args);
  80             last CONSTRAINT;
  81           }
  82         }
  83         $constraint = $constraint->parent;
  84       }
  85       if (!defined($constraint)) {
  86         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";
  87       }
  88     } else {
  89       confess "Can't build field ${attr} without $builder method or type constraint";
  90     }
  91     return @fields;
  92   };
  93
  94   implements _build_field_map => as {
  95     confess "Lazy field map building not supported by default";
  96   };
  97
  98   implements build_ordered_fields => as {
  99     my $self = shift;
 100     my $ordered = $self->sort_by_spec($self->column_order, [keys %{$self->_field_map}]);
 101     return [@{$self->_field_map}{@$ordered}];
 102   };
 103
 104   implements build_simple_field => as {
 105     my ($self, $class, $attr, $args) = @_;
 106     my $attr_name = $attr->name;
 107     my %extra;
 108     if (my $config = $args->{Field}{$attr_name}) {
 109       %extra = %$config;
 110     }
 111     my $field = $class->new(
 112                   object => $self->object,
 113                   attribute => $attr,
 114                   name => $attr->name,
 115                   location => join('-', $self->location, 'field', $attr->name),
 116                   ctx => $self->ctx,
 117                   %extra
 118                 );
 119     return ($attr_name => $field);
 120   };
 121
 122   implements build_fields_for_type_Num => as {
 123     my ($self, $attr, $args) = @_;
 124     return $self->build_simple_field(Number, $attr, $args);
 125   };
 126
 127   implements build_fields_for_type_Int => as {
 128     my ($self, $attr, $args) = @_;
 129     return $self->build_simple_field(Number, $attr, $args);
 130   };
 131
 132   implements build_fields_for_type_Bool => as {
 133     my ($self, $attr, $args) = @_;
 134     return $self->build_simple_field(Boolean, $attr, $args);
 135   };
 136
 137   implements build_fields_for_type_Password => as { return };
 138
 139   implements build_fields_for_type_Str => as {
 140     my ($self, $attr, $args) = @_;
 141     return $self->build_simple_field(String, $attr, $args);
 142   };
 143
 144   implements build_fields_for_type_SimpleStr => as {
 145     my ($self, $attr, $args) = @_;
 146     return $self->build_simple_field(String, $attr, $args);
 147   };
 148
 149   implements build_fields_for_type_DateTime => as {
 150     my ($self, $attr, $args) = @_;
 151     return $self->build_simple_field(DateTime, $attr, $args);
 152   };
 153
 154   implements build_fields_for_type_Enum => as {
 155     my ($self, $attr, $args) = @_;
 156     return $self->build_simple_field(String, $attr, $args);
 157   };
 158
 159   implements build_fields_for_type_ArrayRef => as {
 160     my ($self, $attr, $args) = @_;
 161     return $self->build_simple_field(List, $attr, $args)
 162   };
 163
 164   implements build_fields_for_type_Reaction_InterfaceModel_Collection => as {
 165     my ($self, $attr, $args) = @_;
 166     return $self->build_simple_field(Collection, $attr, $args)
 167   };
 168
 169   implements build_fields_for_type_Reaction_InterfaceModel_Object => as {
 170     my ($self, $attr, $args) = @_;
 171     return $self->build_simple_field(RelatedObject, $attr, $args);
 172   };
 173
 174   no Moose;
 175
 176   no strict 'refs';
 177   delete ${__PACKAGE__ . '::'}{inner};
 178
 179 };
 180
 181 1;