lib/Reaction/UI/ViewPort/ListView.pm

   1 package Reaction::UI::ViewPort::ListView;
   2
   3 use Reaction::Class;
   4 use Data::Page;
   5 use Text::CSV_XS;
   6 use Scalar::Util qw/blessed/;
   7
   8 class ListView is 'Reaction::UI::ViewPort', which {
   9   has collection => (isa => 'Reaction::InterfaceModel::Collection',
  10                        is => 'rw', required => 1);
  11
  12   has current_collection => (
  13     isa => 'Reaction::InterfaceModel::Collection', is => 'rw',
  14     lazy_build => 1, clearer => 'clear_current_collection',
  15   );
  16
  17   has current_page_collection => (
  18     isa => 'Reaction::InterfaceModel::Collection', is => 'rw',
  19     lazy_build => 1, clearer => 'clear_current_page_collection',
  20   );
  21
  22   has page => (
  23     isa => 'Int', is => 'rw', required => 1,
  24     default => sub { 1 }, trigger_adopt('page'),
  25   );
  26
  27   has pager => (
  28     isa => 'Data::Page', is => 'rw',
  29     lazy_build => 1, clearer => 'clear_pager',
  30   );
  31
  32   has per_page => (
  33     isa => 'Int', is => 'rw', predicate => 'has_per_page',
  34     default => sub { 10 }, trigger_adopt('page'),
  35     clearer => 'clear_per_page',
  36   );
  37
  38   has field_names => (is => 'rw', isa => 'ArrayRef', lazy_build => 1);
  39
  40   has field_label_map => (is => 'rw', isa => 'HashRef', lazy_build => 1);
  41
  42   has order_by => (
  43     isa => 'Str', is => 'rw', predicate => 'has_order_by',
  44     trigger_adopt('order_by')
  45   );
  46
  47   has order_by_desc => (
  48     isa => 'Int', is => 'rw', default => sub { 0 },
  49     trigger_adopt('order_by')
  50   );
  51
  52   has row_action_prototypes => (isa => 'ArrayRef', is => 'ro', lazy_build => 1);
  53
  54   has exclude_columns =>
  55       ( is => 'rw', isa => 'ArrayRef', required => 1, default => sub{ [] } );
  56
  57   implements BUILD => as {
  58     my ($self, $args) = @_;
  59     if ($args->{unpaged}) {
  60       $self->clear_per_page;
  61     }
  62   };
  63
  64   sub field_label { shift->field_label_map->{+shift}; }
  65
  66   implements build_pager => as {
  67     my ($self) = @_;
  68     return $self->current_page_collection->pager;
  69   };
  70
  71   implements adopt_page => as {
  72     my ($self) = @_;
  73     $self->clear_current_page_collection;
  74     $self->clear_pager;
  75   };
  76
  77   implements adopt_order_by => as {
  78     my ($self) = @_;
  79     $self->clear_current_collection;
  80     $self->clear_current_page_collection;
  81   };
  82
  83   implements build_current_collection => as {
  84     my ($self) = @_;
  85     my %attrs;
  86
  87     #XXX DBICism that needs to be fixed
  88     if ($self->has_order_by) {
  89       $attrs{order_by} = $self->order_by;
  90       if ($self->order_by_desc) {
  91         $attrs{order_by} .= ' DESC';
  92       }
  93     }
  94     return $self->collection->where(undef, \%attrs);
  95   };
  96
  97   implements build_current_page_collection => as {
  98     my ($self) = @_;
  99     my %attrs;
 100     return $self->current_collection unless $self->has_per_page;
 101     $attrs{rows} = $self->per_page;
 102     return $self->current_collection->where(undef, \%attrs)->page($self->page);
 103   };
 104
 105   implements all_current_rows => as {
 106     return shift->current_collection->members;
 107   };
 108
 109   implements current_rows => as {
 110     return shift->current_page_collection->members;
 111   };
 112
 113   implements build_field_names => as {
 114     my ($self) = @_;
 115     #XXX candidate for future optimization
 116     my %excluded = map { $_ => undef } @{ $self->exclude_columns };
 117
 118     #XXX this abuse of '_im_class' needs to be fixed ASAP
 119     my $object_class = $self->current_collection->_im_class;
 120     my @fields = $object_class->meta->compute_all_applicable_attributes;
 121     #eliminate excluded fields & treat names that start with an underscore as private
 122     @fields = grep {$_->name !~ /^_/ && !exists $excluded{$_->name} } @fields;
 123     #eliminate fields marked as collections, or fields that are arrayrefs
 124     @fields = grep {
 125       !($_->has_type_constraint &&
 126         ($_->type_constraint->is_a_type_of('ArrayRef') ||
 127          eval {$_->type_constraint->name->isa('Reaction::InterfaceModel::Collection')} ||
 128          eval { $_->_isa_metadata->isa('Reaction::InterfaceModel::Collection') }
 129         )
 130        )  } @fields;
 131
 132     #for(grep { $_->has_type_constraint } @fields){
 133       #my $tcname = $_->type_constraint->name;
 134       #print STDERR $_->name, "\t", $tcname, "\n";
 135       #use Data::Dumper;
 136       #print STDERR Dumper($_->type_constraint);
 137     #}
 138
 139     #order the columns all nice and pretty, and only get fields with readers, duh
 140     return $self->sort_by_spec
 141       ( $self->column_order, [ map { (($_->get_read_method) || ()) } @fields] );
 142   };
 143
 144   implements build_field_label_map => as {
 145     my ($self) = @_;
 146     my %labels;
 147     foreach my $name (@{$self->field_names}) {
 148       $labels{$name} = join(' ', map { ucfirst } split('_', $name));
 149     }
 150     return \%labels;
 151   };
 152
 153   #XXX this has to go soon, I recommend that Objects hold a registry of their actions
 154   #and that they can be queried about it somehow
 155   implements build_row_action_prototypes => as {
 156     my $self = shift;
 157     my $ctx = $self->ctx;
 158     return [
 159       { label => 'View', action => sub {
 160         [ '', 'view', [ @{$ctx->req->captures},   $_[0]->__id ] ] } },
 161       { label => 'Edit', action => sub {
 162         [ '', 'update', [ @{$ctx->req->captures}, $_[0]->__id ] ] } },
 163       { label => 'Delete', action => sub {
 164         [ '', 'delete', [ @{$ctx->req->captures}, $_[0]->__id ] ] } },
 165     ];
 166   };
 167
 168   implements row_actions_for => as {
 169     my ($self, $row) = @_;
 170     my @act;
 171     my $c = $self->ctx;
 172     foreach my $proto (@{$self->row_action_prototypes}) {
 173       my %new = %$proto;
 174       my ($c_name, $a_name, @rest) = @{delete($new{action})->($row)};
 175       $new{label} = delete($new{label})->($row) if ref $new{label} eq 'CODE';
 176       $new{uri} = $c->uri_for(
 177                     $c->controller($c_name)->action_for($a_name),
 178                     @rest
 179                   );
 180       push(@act, \%new);
 181     }
 182     return \@act;
 183   };
 184
 185   implements export_to_csv => as {
 186     my ($self) = @_;
 187     my $csv = Text::CSV_XS->new( {  binary => 1 } );
 188     my $output;
 189     my $exporter = sub {
 190       $csv->combine( @_ );
 191       $output .= $csv->string."\r\n";
 192     };
 193     $self->export_to_data($exporter);
 194     my $res = $self->ctx->res;
 195     $res->content_type('text/csv');
 196     my $path = $self->ctx->req->path;
 197     my @parts = split(/\//, $path);
 198     $res->header(
 199       'Content-disposition' => 'attachment; filename='.pop(@parts).'.csv'
 200     );
 201     $res->body($output);
 202   };
 203
 204   implements export_to_data => as {
 205     my ($self, $exporter) = @_;
 206     $self->export_header_data($exporter);
 207     $self->export_body_data($exporter);
 208   };
 209
 210   implements export_header_data => as {
 211     my ($self, $exporter) = @_;
 212     my @names = @{$self->field_names};
 213     my %labels = %{$self->field_label_map};
 214     $exporter->( map { $labels{$_} } @names );
 215   };
 216
 217   implements export_body_data => as {
 218     my ($self, $exporter) = @_;
 219     my @names = @{$self->field_names};
 220     foreach my $row ($self->all_current_rows) {
 221       my @row_data;
 222       foreach $_ (@names) {
 223         my $data = $row->$_;
 224         if (blessed($data) && $data->can("display_name")) {
 225           $data = $data->display_name;
 226         }
 227         push(@row_data, $data);
 228       }
 229       $exporter->( @row_data );
 230     }
 231   };
 232
 233   override accept_events => sub { ('page', 'order_by', 'order_by_desc', 'export_to_csv', super()); };
 234
 235 };
 236
 237 1;
 238
 239 =head1 NAME
 240
 241 Reaction::UI::ViewPort::ListView - Page layout block for rows of DBIx::Class::ResultSets
 242
 243 =head1 SYNOPSIS
 244
 245   # Create a new ListView
 246   # $stack isa Reaction::UI::FocusStack object
 247   # Assuming you have a DBIC model with an Actors table
 248   my $lv = $stack->push_viewport(
 249     'Reaction::UI::ViewPort::ListView',
 250     collection => $ctx->model('DBIC::Actors'),     # a DBIx::Class::ResultSet
 251     page => 1,                                     # 1 is default
 252     per_page => 10,                                # 10 is default
 253     field_names => [qw/name age/],
 254     field_label_map => {
 255       'name' => 'Name',
 256       'age' => 'Age',
 257     },
 258     order_by => 'name',
 259   );
 260
 261 =head1 DESCRIPTION
 262
 263 Use this ViewPort to display the contents of a
 264 L<DBIx::Class::ResultSet> as paged sets of rows. The default display
 265 shows 10 rows per page, unsorted.
 266
 267 TODO: Add a filter_by which allows us to restrict the content?
 268 (Scenario: user has a paged display of data, user selects one value in
 269 a column and clicks "filter by this value", and then only rows
 270 containing that value are shown.
 271
 272 =head1 ATTRIIBUTES
 273
 274 =head2 collection
 275
 276 This mandatory attribute must be an object derived from
 277 L<DBIx::Class::ResultSet> representing the search result or result
 278 source(Table) you wish to display in the ListView.
 279
 280 The collection is used as the basis to create a refined set of data to
 281 show in the current ListView, this is stored in
 282 L<current_collection>. The data can further be refined and restricted
 283 by passing in or later changing the L<order_by> or L<page>
 284 attributes. The
 285
 286 =head2 order_by
 287
 288 A string representing the C<ORDER BY> part of the SQL statement, for
 289 more info see L<DBIx::Class::ResultSet/Attributes>
 290
 291 =head2 order_by_desc
 292
 293 By default, sorting is done in ascending order, set this to true to
 294 sort in descending order. Changing this attribute will cause the
 295 L<current_collection> to be cleared and recreated on the next access .
 296
 297 =head2 exclude_columns
 298
 299
 300
 301 =head2 page
 302
 303 The page number of the current search result, this will default to
 304 1. If set explicitly on the ListView object, the current search result
 305 and the pager will be cleared and recreated on the next access.
 306
 307 =head2 per_page
 308
 309 The number of rows of data to list on each page. Changing this value
 310 on the ListView object will cause the L<current_page_collection> and
 311 the L<pager> to be cleared and recreated on the next access. This will
 312 default to 10 if unset.
 313
 314 =head2 unpaged
 315
 316 Set this to a true value if you really don't want your results shown
 317 in pages.
 318
 319 =head2 field_names
 320
 321 An array reference of field names to show in the ListView. These must
 322 exist as accessors in the L<DBIx::Class::ResultSource> describing the
 323 L<DBIx::Class::ResultSet> passed to L<collection>.
 324
 325 If not set, this will default to the list of attributes in the
 326 L<DBIx::Class::ResultSource> which do not begin with an underscore,
 327 and don't have a type of either ArrayRef or
 328 C<DBIx::Class::ResultSet>. In short, all the non-private and
 329 non-relation attributes.
 330
 331 =head2 field_label_map
 332
 333 A hash reference mapping the L<field_names> to the column labels used
 334 to describe them in the ListView display.
 335
 336 If not set, the label values will default to the L<field_names> with
 337 the initial characters capitalised and underscores turned into spaces.
 338
 339 =head2 row_action_prototypes
 340
 341   row_action_prototypes => [
 342     { label => 'Edit', action => sub { [ '', 'update', [ $_[0]->id ] ] } },
 343     { label => 'Delete', action => sub { [ '', 'delete', [ $_[0]->id ] ] } },
 344   ];
 345
 346 Prototypes describing the actions that can be done on the rows of
 347 ListView data. This is an array reference of hash refs describing the
 348 name of each action with a C<label>, and the actual C<action> that
 349 takes place. The code reference stored in the C<action > will be
 350 called with a L<DBIx::Class::Row> object, it should return a list of a
 351 L<Catalyst::Controller> name, the name of an action in that
 352 controller, and any other parameters that need to be passed to
 353 it. C<label> may be a scalar value or a code reference, in the later case
 354 it will be called with the same parameters as C<action> and the return value
 355 will be used as the C<label> value.
 356
 357 The example above shows the default actions if this attribute is not set.
 358
 359 =head2 current_collection
 360
 361 This contains the currently used L<DBIx::Class::ResultSet>
 362 representing the ListViews data, it is based on the L<collection>
 363 ResultSet, refined using the L<order_by> and L<order_by_desc> attributes.
 364
 365 The current_collection will be cleared and recreated if the
 366 L<order_by> or L<order_by_desc> attributes are changed on the ListView
 367 object.
 368
 369 =head2 current_rows
 370
 371 =head2 all_current_rows
 372
 373 =head2 pager
 374
 375 A L<Data::Page> object representing the data for the current search
 376 result, it is cleared and reset when either L<page> or L<order_by> are
 377 changed.
 378
 379 =head2 current_page_collection
 380
 381 This contains contains a single page of the contents of the
 382 L<current_collection>, with the L<per_page> number of rows
 383 requested. If the L<page>, L<per_page>, L_order_by> or
 384 L<order_by_desc> attributes are changed on the ListView object, the
 385 current_page_collection is cleared and recreated.
 386
 387 =head1 METHODS
 388
 389 =head2 row_actions_for
 390
 391 =over 4
 392
 393 =item Arguments: none
 394
 395 =back
 396
 397 Returns an array reference of uris and labels representing the actions
 398 set in L<row_action_prototypes>. L<Catalyst/uri_for> is used to
 399 construct these.
 400
 401 =head2 export_header_data
 402
 403 =over 4
 404
 405 =item Arguments: $exporter
 406
 407 =back
 408
 409   $lv->export_head_data($exporter);
 410
 411 C<$exporter> should be a code reference which will export lists of
 412 data passed to it. This method calls the C<exporter> code reference
 413 passing it the labels from the L<field_label_map> using the current
 414 set of L<field_names>.
 415
 416 =head2 export_body_data
 417
 418 =over 4
 419
 420 =item Arguments: $exporter
 421
 422 =back
 423
 424   $lv->export_body_data($exporter);
 425
 426 C<$exporter> should be a code reference which will export lists of
 427 data passed to it. This method calls the C<exporter> code reference
 428 with an array of rows containing the data values of each of the
 429 current L<field_values>.
 430
 431 =head2 export_to_data
 432
 433 =over 4
 434
 435 =item Arguments: $exporter
 436
 437 =back
 438
 439   $lv->export_to_data($exporter);
 440
 441 C<$exporter> should be a code reference which will export lists of
 442 data passed to it. This method calls L<export_header_data> and
 443 L<export_body_data> with C<exporter>.
 444
 445 =head2 export_to_csv
 446
 447 =over 4
 448
 449 =item Arguments: none
 450
 451 =back
 452
 453   $lv->export_to_csv();
 454
 455 Fills the L<Catalyst::Response> body with CSV data of the
 456 L<current_collection> using L<export_to_data> and L<Text::CSV_XS>.
 457
 458 =head2 field_label
 459
 460 =over 4
 461
 462 =item Arguments: $field_name
 463
 464 =back
 465
 466 Returns the label for the given C<field_name>, using L<field_label_map>.
 467
 468 =head1 AUTHORS
 469
 470 See L<Reaction::Class> for authors.
 471
 472 =head1 LICENSE
 473
 474 See L<Reaction::Class> for the license.
 475
 476 =cut