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_names => (isa => 'ArrayRef', is => 'rw', lazy_build => 1);
  20
  21   has _field_map => (
  22     isa => 'HashRef', is => 'rw', init_arg => 'fields',
  23     predicate => '_has_field_map', set_or_lazy_build('field_map'),
  24   );
  25
  26   has exclude_fields =>
  27       ( is => 'rw', isa => 'ArrayRef', required => 1, default => sub{ [] } );
  28
  29   sub fields { 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       my @field_names = @{ $self->sort_by_spec(
  43           $args->{column_order}, [keys %field_map] )};
  44
  45       $self->_field_map(\%field_map);
  46       $self->field_names(\@field_names);
  47     }
  48   };
  49
  50   implements build_fields_for => as {
  51     my ($self, $attr, $args) = @_;
  52     my $attr_name = $attr->name;
  53     my $builder = "build_fields_for_name_${attr_name}";
  54     my @fields;
  55     if ($self->can($builder)) {
  56       @fields = $self->$builder($attr, $args); # re-use coderef from can()
  57     } elsif ($attr->has_type_constraint) {
  58       my $constraint = $attr->type_constraint;
  59       my $base_name = $constraint->name;
  60       my $tried_isa = 0;
  61       CONSTRAINT: while (defined($constraint)) {
  62         my $name = $constraint->name;
  63         if (eval { $name->can('meta') } && !$tried_isa++) {
  64           foreach my $class ($name->meta->class_precedence_list) {
  65             my $mangled_name = $class;
  66             $mangled_name =~ s/:+/_/g;
  67             my $builder = "build_fields_for_type_${mangled_name}";
  68             if ($self->can($builder)) {
  69               @fields = $self->$builder($attr, $args);
  70               last CONSTRAINT;
  71             }
  72           }
  73         }
  74         if (defined($name)) {
  75           unless (defined($base_name)) {
  76             $base_name = "(anon subtype of ${name})";
  77           }
  78           my $mangled_name = $name;
  79           $mangled_name =~ s/:+/_/g;
  80           my $builder = "build_fields_for_type_${mangled_name}";
  81           if ($self->can($builder)) {
  82             @fields = $self->$builder($attr, $args);
  83             last CONSTRAINT;
  84           }
  85         }
  86         $constraint = $constraint->parent;
  87       }
  88       if (!defined($constraint)) {
  89         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";
  90       }
  91     } else {
  92       confess "Can't build field ${attr} without $builder method or type constraint";
  93     }
  94     return @fields;
  95   };
  96
  97   implements build_field_map => as {
  98     confess "Lazy field map building not supported by default";
  99   };
 100
 101   implements build_simple_field => as {
 102     my ($self, $class, $attr, $args) = @_;
 103     my $attr_name = $attr->name;
 104     my %extra;
 105     if (my $config = $args->{Field}{$attr_name}) {
 106       %extra = %$config;
 107     }
 108     my $field = $class->new(
 109                   object => $self->object,
 110                   attribute => $attr,
 111                   name => $attr->name,
 112                   location => join('-', $self->location, 'field', $attr->name),
 113                   ctx => $self->ctx,
 114                   %extra
 115                 );
 116     return ($attr_name => $field);
 117   };
 118
 119   implements build_fields_for_type_Num => as {
 120     my ($self, $attr, $args) = @_;
 121     return $self->build_simple_field(Number, $attr, $args);
 122   };
 123
 124   implements build_fields_for_type_Int => as {
 125     my ($self, $attr, $args) = @_;
 126     return $self->build_simple_field(Number, $attr, $args);
 127   };
 128
 129   implements build_fields_for_type_Bool => as {
 130     my ($self, $attr, $args) = @_;
 131     return $self->build_simple_field(Boolean, $attr, $args);
 132   };
 133
 134   implements build_fields_for_type_Password => as { return };
 135
 136   implements build_fields_for_type_Str => as {
 137     my ($self, $attr, $args) = @_;
 138     return $self->build_simple_field(String, $attr, $args);
 139   };
 140
 141   implements build_fields_for_type_SimpleStr => as {
 142     my ($self, $attr, $args) = @_;
 143     return $self->build_simple_field(String, $attr, $args);
 144   };
 145
 146   implements build_fields_for_type_DateTime => as {
 147     my ($self, $attr, $args) = @_;
 148     return $self->build_simple_field(DateTime, $attr, $args);
 149   };
 150
 151   implements build_fields_for_type_Enum => as {
 152     my ($self, $attr, $args) = @_;
 153     return $self->build_simple_field(String, $attr, $args);
 154   };
 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
 173   no Moose;
 174
 175   no strict 'refs';
 176   delete ${__PACKAGE__ . '::'}{inner};
 177
 178 };
 179
 180 1;