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