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