lib/Reaction/UI/ViewPort/GridView.pm

   1 package Reaction::UI::ViewPort::GridView;
   2
   3 use Reaction::Class;
   4
   5 use aliased 'Reaction::InterfaceModel::Collection' => 'IM_Collection';
   6 use aliased 'Reaction::UI::ViewPort::GridView::Entity';
   7
   8 class GridView is 'Reaction::UI::ViewPort', which {
   9
  10   has exclude_fields => ( isa => 'ArrayRef', is => 'ro' );
  11   has field_order    => ( isa => 'ArrayRef', is => 'ro', lazy_build => 1);
  12   has field_labels   => ( isa => 'HashRef',  is => 'ro', lazy_build => 1);
  13
  14
  15   has entities       => ( isa => 'ArrayRef', is => 'rw', lazy_build => 1);
  16
  17   has collection         => (isa => IM_Collection, is => 'ro', required   => 1);
  18   has current_collection => (isa => IM_Collection, is => 'rw', lazy_build => 1);
  19
  20   has entity_class => ( isa => 'Str', is => 'rw', lazy_build => 1);
  21   has entity_args  => ( is => 'rw' );
  22
  23   implements BUILD => as {
  24     my ($self, $args) = @_;
  25     my $entity_args = delete $args->{Entity};
  26     $self->entity_args( $entity_args ) if ref $entity_args;
  27   };
  28
  29   after clear_current_collection => sub{
  30     shift->clear_entities; #clear the entitiesis the current collection changes, duh
  31   };
  32
  33   implements _build_entity_class => as { Entity };
  34
  35   implements _build_field_order => as {
  36     my ($self) = @_;
  37     my %excluded = map { $_ => undef }
  38       @{ $self->has_exclude_fields ? $self->exclude_fields : [] };
  39     #XXX this abuse of '_im_class' needs to be fixed ASAP
  40     my $object_class = $self->collection->_im_class;
  41     my @fields = $object_class->meta->parameter_attributes;
  42     #obviously only get fields with readers.
  43     @fields = grep { $_->get_read_method } @fields;
  44     #eliminate excluded fields & treat names that start with an underscore as private
  45     @fields = grep {$_->name !~ /^_/ && !exists $excluded{$_->name} } @fields;
  46
  47     #eliminate fields marked as collections, or fields that are arrayrefs
  48     @fields = grep {
  49       !($_->has_type_constraint &&
  50         ($_->type_constraint->is_a_type_of('ArrayRef') ||
  51          eval {$_->type_constraint->name->isa('Reaction::InterfaceModel::Collection')} ||
  52          eval { $_->_isa_metadata->isa('Reaction::InterfaceModel::Collection') }
  53         )
  54        )  } @fields;
  55
  56     #order the columns all nice and pretty, and only get fields with readers, duh
  57     my $ordered = $self->sort_by_spec
  58       ( $self->column_order, [ map { (($_->name) || ()) } @fields] );
  59
  60     return $ordered;
  61   };
  62
  63   implements _build_current_collection => as {
  64     shift->collection;
  65   };
  66
  67   implements _build_field_labels => as {
  68     my $self = shift;
  69     my %labels;
  70     for my $field ( @{$self->field_order}){
  71       $labels{$field} = join(' ', map{ ucfirst } split('_', $field));
  72     }
  73     return \%labels;
  74   };
  75
  76   implements _build_entities => as {
  77     my ($self) = @_;
  78     my (@entities, $i);
  79     my $args = $self->has_entity_args ? $self->entity_args : {};
  80     my $builders = {};
  81     my $ctx = $self->ctx;
  82     my $loc = $self->location;
  83     my $order = $self->field_order;
  84     my $class = $self->entity_class;
  85     for my $obj ( $self->current_collection->members ) {
  86       my $row = $class->new(
  87                             ctx           => $ctx,
  88                             object        => $obj,
  89                             location      => join('-', $loc, 'row', $i++),
  90                             field_order   => $order,
  91                             builder_cache => $builders,
  92                             ref $args ? %$args : ()
  93                            );
  94       push(@entities, $row);
  95     }
  96     return \@entities;
  97   };
  98
  99 };
 100
 101
 102
 103 1;