SL/Presenter/Record.pm

   1 package SL::Presenter::Record;
   2
   3 use strict;
   4
   5 use parent qw(Exporter);
   6
   7 use Exporter qw(import);
   8 our @EXPORT = qw(grouped_record_list empty_record_list record_list);
   9
  10 use Carp;
  11 use List::Util qw(first);
  12
  13 sub _arrayify {
  14   my ($array) = @_;
  15   return []     if !defined $array;
  16   return $array if ref $array;
  17   return [ $array ];
  18 }
  19
  20 sub grouped_record_list {
  21   my ($self, $list, %params) = @_;
  22
  23   %params                = map { exists $params{$_} ? ($_ => $params{$_}) : () } qw(edit_record_links form_prefix with_columns object_id object_model);
  24   $params{form_prefix} ||= 'record_links';
  25
  26   my %groups = _group_records($list);
  27   my $output = '';
  28
  29   $output .= _sales_quotation_list(        $self, $groups{sales_quotations},         %params) if $groups{sales_quotations};
  30   $output .= _sales_order_list(            $self, $groups{sales_orders},             %params) if $groups{sales_orders};
  31   $output .= _sales_delivery_order_list(   $self, $groups{sales_delivery_orders},    %params) if $groups{sales_delivery_orders};
  32   $output .= _sales_invoice_list(          $self, $groups{sales_invoices},           %params) if $groups{sales_invoices};
  33   $output .= _ar_transaction_list(         $self, $groups{ar_transactions},          %params) if $groups{ar_transactions};
  34
  35   $output .= _request_quotation_list(      $self, $groups{purchase_quotations},      %params) if $groups{purchase_quotations};
  36   $output .= _purchase_order_list(         $self, $groups{purchase_orders},          %params) if $groups{purchase_orders};
  37   $output .= _purchase_delivery_order_list($self, $groups{purchase_delivery_orders}, %params) if $groups{purchase_delivery_orders};
  38   $output .= _purchase_invoice_list(       $self, $groups{purchase_invoices},        %params) if $groups{purchase_invoices};
  39   $output .= _ar_transaction_list(         $self, $groups{ar_transactions},          %params) if $groups{ar_transactions};
  40
  41   $output  = $self->render('presenter/record/grouped_record_list', %params, output => $output, nownow => DateTime->now) if $output;
  42
  43   return $output || $self->empty_record_list;
  44 }
  45
  46 sub empty_record_list {
  47   my ($self) = @_;
  48   return $self->render('presenter/record/empty_record_list');
  49 }
  50
  51 sub record_list {
  52   my ($self, $list, %params) = @_;
  53
  54   my @columns;
  55
  56   if (ref($params{columns}) eq 'ARRAY') {
  57     @columns = map {
  58       if (ref($_) eq 'ARRAY') {
  59         { title => $_->[0], data => $_->[1], link => $_->[2] }
  60       } else {
  61         $_;
  62       }
  63     } @{ delete $params{columns} };
  64
  65   } else {
  66     croak "Wrong type for 'columns' argument: not an array reference";
  67   }
  68
  69   my %with_columns = map { ($_ => 1) } @{ _arrayify($params{with_columns}) };
  70   if ($with_columns{record_link_direction}) {
  71     push @columns, {
  72       title => $::locale->text('Link direction'),
  73       data  => sub { $_[0]->{_record_link_direction} eq 'from' ? $::locale->text('Row was source for current record') : $::locale->text('Row was created from current record') },
  74     };
  75   }
  76
  77   my %column_meta   = map { $_->name => $_ } @{ $list->[0]->meta->columns       };
  78   my %relationships = map { $_->name => $_ } @{ $list->[0]->meta->relationships };
  79
  80   my $call = sub {
  81     my ($obj, $method, @args) = @_;
  82     $obj->$method(@args);
  83   };
  84
  85   my @data;
  86   foreach my $obj (@{ $list }) {
  87     my @row;
  88
  89     foreach my $spec (@columns) {
  90       my %cell;
  91
  92       my $method       =  $spec->{column} || $spec->{data};
  93       my $meta         =  $column_meta{ $spec->{data} };
  94       my $type         =  ref $meta;
  95       my $relationship =  $relationships{ $spec->{data} };
  96       my $rel_type     =  !$relationship ? '' : lc $relationship->class;
  97       $rel_type        =~ s/^sl::db:://;
  98
  99       if (ref($spec->{data}) eq 'CODE') {
 100         $cell{value} = $spec->{data}->($obj);
 101
 102       } else {
 103         $cell{value} = $rel_type && $self->can($rel_type)                                       ? $self->$rel_type($obj->$method, display => 'table-cell')
 104                      : $type eq 'Rose::DB::Object::Metadata::Column::Date'                      ? $call->($obj, $method . '_as_date')
 105                      : $type =~ m/^Rose::DB::Object::Metadata::Column::(?:Float|Numeric|Real)$/ ? $::form->format_amount(\%::myconfig, $call->($obj, $method), 2)
 106                      : $type eq 'Rose::DB::Object::Metadata::Column::Boolean'                   ? $call->($obj, $method . '_as_bool_yn')
 107                      : $type =~ m/^Rose::DB::Object::Metadata::Column::(?:Integer|Serial)$/     ? $spec->{data} * 1
 108                      :                                                                            $call->($obj, $method);
 109       }
 110
 111       $cell{alignment} = 'right' if $type =~ m/int|serial|float|real|numeric/;
 112
 113       push @row, \%cell;
 114     }
 115
 116     push @data, { columns => \@row, record_link => $obj->{_record_link} };
 117   }
 118
 119   my @header =
 120     map +{ value     => $columns[$_]->{title},
 121            alignment => $data[0]->{columns}->[$_]->{alignment},
 122          }, (0..scalar(@columns) - 1);
 123
 124   $params{form_prefix} ||= 'record_links';
 125
 126   return $self->render(
 127     'presenter/record/record_list',
 128     %params,
 129     TABLE_HEADER => \@header,
 130     TABLE_ROWS   => \@data,
 131   );
 132 }
 133
 134 #
 135 # private methods
 136 #
 137
 138 sub _group_records {
 139   my ($list) = @_;
 140
 141   my %matchers = (
 142     sales_quotations         => sub { (ref($_[0]) eq 'SL::DB::Order')           &&  $_[0]->is_type('sales_quotation')   },
 143     sales_orders             => sub { (ref($_[0]) eq 'SL::DB::Order')           &&  $_[0]->is_type('sales_order')       },
 144     sales_delivery_orders    => sub { (ref($_[0]) eq 'SL::DB::DeliveryOrder')   &&  $_[0]->is_sales                     },
 145     sales_invoices           => sub { (ref($_[0]) eq 'SL::DB::Invoice')         &&  $_[0]->invoice                      },
 146     ar_transactions          => sub { (ref($_[0]) eq 'SL::DB::Invoice')         && !$_[0]->invoice                      },
 147     purchase_quotations      => sub { (ref($_[0]) eq 'SL::DB::Order')           &&  $_[0]->is_type('request_quotation') },
 148     purchase_orders          => sub { (ref($_[0]) eq 'SL::DB::Order')           &&  $_[0]->is_type('purchase_order')    },
 149     purchase_delivery_orders => sub { (ref($_[0]) eq 'SL::DB::DeliveryOrder')   && !$_[0]->is_sales                     },
 150     purchase_invoices        => sub { (ref($_[0]) eq 'SL::DB::PurchaseInvoice') &&  $_[0]->invoice                      },
 151     ap_transactions          => sub { (ref($_[0]) eq 'SL::DB::PurchaseInvoice') && !$_[0]->invoice                      },
 152   );
 153
 154   my %groups;
 155
 156   foreach my $record (@{ $list || [] }) {
 157     my $type         = (first { $matchers{$_}->($record) } keys %matchers) || 'other';
 158     $groups{$type} ||= [];
 159     push @{ $groups{$type} }, $record;
 160   }
 161
 162   return %groups;
 163 }
 164
 165 sub _sales_quotation_list {
 166   my ($self, $list, %params) = @_;
 167
 168   return $self->record_list(
 169     $list,
 170     title   => $::locale->text('Sales Quotations'),
 171     columns => [
 172       [ $::locale->text('Quotation Date'),          'transdate'                                                                ],
 173       [ $::locale->text('Quotation Number'),        sub { $self->sales_quotation($_[0], display => 'table-cell') }   ],
 174       [ $::locale->text('Customer'),                'customer'                                                                 ],
 175       [ $::locale->text('Net amount'),              'netamount'                                                                ],
 176       [ $::locale->text('Transaction description'), 'transaction_description'                                                  ],
 177       [ $::locale->text('Project'),                 'globalproject', ],
 178       [ $::locale->text('Closed'),                  'closed'                                                                   ],
 179     ],
 180     %params,
 181   );
 182 }
 183
 184 sub _request_quotation_list {
 185   my ($self, $list, %params) = @_;
 186
 187   return $self->record_list(
 188     $list,
 189     title   => $::locale->text('Request Quotations'),
 190     columns => [
 191       [ $::locale->text('Quotation Date'),          'transdate'                                                                ],
 192       [ $::locale->text('Quotation Number'),        sub { $self->sales_quotation($_[0], display => 'table-cell') }   ],
 193       [ $::locale->text('Vendor'),                  'vendor'                                                                   ],
 194       [ $::locale->text('Net amount'),              'netamount'                                                                ],
 195       [ $::locale->text('Transaction description'), 'transaction_description'                                                  ],
 196       [ $::locale->text('Project'),                 'globalproject', ],
 197       [ $::locale->text('Closed'),                  'closed'                                                                   ],
 198     ],
 199     %params,
 200   );
 201 }
 202
 203 sub _sales_order_list {
 204   my ($self, $list, %params) = @_;
 205
 206   return $self->record_list(
 207     $list,
 208     title   => $::locale->text('Sales Orders'),
 209     columns => [
 210       [ $::locale->text('Order Date'),              'transdate'                                                                ],
 211       [ $::locale->text('Order Number'),            sub { $self->sales_order($_[0], display => 'table-cell') }   ],
 212       [ $::locale->text('Quotation'),               'quonumber' ],
 213       [ $::locale->text('Customer'),                'customer'                                                                 ],
 214       [ $::locale->text('Net amount'),              'netamount'                                                                ],
 215       [ $::locale->text('Transaction description'), 'transaction_description'                                                  ],
 216       [ $::locale->text('Project'),                 'globalproject', ],
 217       [ $::locale->text('Closed'),                  'closed'                                                                   ],
 218     ],
 219     %params,
 220   );
 221 }
 222
 223 sub _purchase_order_list {
 224   my ($self, $list, %params) = @_;
 225
 226   return $self->record_list(
 227     $list,
 228     title   => $::locale->text('Purchase Orders'),
 229     columns => [
 230       [ $::locale->text('Order Date'),              'transdate'                                                                ],
 231       [ $::locale->text('Order Number'),            sub { $self->sales_order($_[0], display => 'table-cell') }   ],
 232       [ $::locale->text('Request for Quotation'),   'quonumber' ],
 233       [ $::locale->text('Vendor'),                  'vendor'                                                                 ],
 234       [ $::locale->text('Net amount'),              'netamount'                                                                ],
 235       [ $::locale->text('Transaction description'), 'transaction_description'                                                  ],
 236       [ $::locale->text('Project'),                 'globalproject', ],
 237       [ $::locale->text('Closed'),                  'closed'                                                                   ],
 238     ],
 239     %params,
 240   );
 241 }
 242
 243 sub _sales_delivery_order_list {
 244   my ($self, $list, %params) = @_;
 245
 246   return $self->record_list(
 247     $list,
 248     title   => $::locale->text('Sales Delivery Orders'),
 249     columns => [
 250       [ $::locale->text('Delivery Order Date'),     'transdate'                                                                ],
 251       [ $::locale->text('Delivery Order Number'),   sub { $self->sales_delivery_order($_[0], display => 'table-cell') } ],
 252       [ $::locale->text('Order Number'),            'ordnumber' ],
 253       [ $::locale->text('Customer'),                'customer'                                                                 ],
 254       [ $::locale->text('Transaction description'), 'transaction_description'                                                  ],
 255       [ $::locale->text('Project'),                 'globalproject', ],
 256       [ $::locale->text('Delivered'),               'delivered'                                                                ],
 257       [ $::locale->text('Closed'),                  'closed'                                                                   ],
 258     ],
 259     %params,
 260   );
 261 }
 262
 263 sub _purchase_delivery_order_list {
 264   my ($self, $list, %params) = @_;
 265
 266   return $self->record_list(
 267     $list,
 268     title   => $::locale->text('Purchase Delivery Orders'),
 269     columns => [
 270       [ $::locale->text('Delivery Order Date'),     'transdate'                                                                ],
 271       [ $::locale->text('Delivery Order Number'),   sub { $self->sales_delivery_order($_[0], display => 'table-cell') } ],
 272       [ $::locale->text('Order Number'),            'ordnumber' ],
 273       [ $::locale->text('Vendor'),                  'vendor'                                                                 ],
 274       [ $::locale->text('Transaction description'), 'transaction_description'                                                  ],
 275       [ $::locale->text('Project'),                 'globalproject', ],
 276       [ $::locale->text('Delivered'),               'delivered'                                                                ],
 277       [ $::locale->text('Closed'),                  'closed'                                                                   ],
 278     ],
 279     %params,
 280   );
 281 }
 282
 283 sub _sales_invoice_list {
 284   my ($self, $list, %params) = @_;
 285
 286   return $self->record_list(
 287     $list,
 288     title   => $::locale->text('Sales Invoices'),
 289     columns => [
 290       [ $::locale->text('Invoice Date'),            'transdate'               ],
 291       [ $::locale->text('Invoice Number'),          sub { $self->sales_invoice($_[0], display => 'table-cell') } ],
 292       [ $::locale->text('Quotation Number'),        'quonumber' ],
 293       [ $::locale->text('Order Number'),            'ordnumber' ],
 294       [ $::locale->text('Customer'),                'customer'                ],
 295       [ $::locale->text('Net amount'),              'netamount'               ],
 296       [ $::locale->text('Paid'),                    'paid'                    ],
 297       [ $::locale->text('Transaction description'), 'transaction_description' ],
 298     ],
 299     %params,
 300   );
 301 }
 302
 303 sub _purchase_invoice_list {
 304   my ($self, $list, %params) = @_;
 305
 306   return $self->record_list(
 307     $list,
 308     title   => $::locale->text('Purchase Invoices'),
 309     columns => [
 310       [ $::locale->text('Invoice Date'),                 'transdate'               ],
 311       [ $::locale->text('Invoice Number'),               sub { $self->sales_invoice($_[0], display => 'table-cell') } ],
 312       [ $::locale->text('Request for Quotation Number'), 'quonumber' ],
 313       [ $::locale->text('Order Number'),                 'ordnumber' ],
 314       [ $::locale->text('Vendor'),                       'vendor'                 ],
 315       [ $::locale->text('Net amount'),                   'netamount'               ],
 316       [ $::locale->text('Paid'),                         'paid'                    ],
 317       [ $::locale->text('Transaction description'),      'transaction_description' ],
 318     ],
 319     %params,
 320   );
 321 }
 322
 323 sub _ar_transaction_list {
 324   my ($self, $list, %params) = @_;
 325
 326   return $self->record_list(
 327     $list,
 328     title   => $::locale->text('AR Transactions'),
 329     columns => [
 330       [ $::locale->text('Invoice Date'),            'transdate'               ],
 331       [ $::locale->text('Invoice Number'),          sub { $self->ar_transaction($_[0], display => 'table-cell') } ],
 332       [ $::locale->text('Customer'),                'customer'                ],
 333       [ $::locale->text('Net amount'),              'netamount'               ],
 334       [ $::locale->text('Paid'),                    'paid'                    ],
 335       [ $::locale->text('Transaction description'), 'transaction_description' ],
 336     ],
 337     %params,
 338   );
 339 }
 340
 341 sub _ap_transaction_list {
 342   my ($self, $list, %params) = @_;
 343
 344   return $self->record_list(
 345     $list,
 346     title   => $::locale->text('AP Transactions'),
 347     columns => [
 348       [ $::locale->text('Invoice Date'),            'transdate'                      ],
 349       [ $::locale->text('Invoice Number'),          sub { $self->ar_transaction($_[0 ], display => 'table-cell') } ],
 350       [ $::locale->text('Vendor'),                  'vendor'                         ],
 351       [ $::locale->text('Net amount'),              'netamount'                      ],
 352       [ $::locale->text('Paid'),                    'paid'                           ],
 353       [ $::locale->text('Transaction description'), 'transaction_description'        ],
 354     ],
 355     %params,
 356   );
 357 }
 358
 359 1;
 360
 361 __END__
 362
 363 =pod
 364
 365 =encoding utf8
 366
 367 =head1 NAME
 368
 369 SL::Presenter::Record - Presenter module for lists of
 370 sales/purchase/general ledger record Rose::DB objects
 371
 372 =head1 SYNOPSIS
 373
 374   # Retrieve a number of documents from somewhere, e.g.
 375   my $order   = SL::DB::Manager::Order->get_first(where => [ SL::DB::Manager::Order->type_filter('sales_order') ]);
 376   my $records = $order->linked_records(destination => 'to');
 377
 378   # Give HTML representation:
 379   my $html = SL::Presenter->get->grouped_record_list($records);
 380
 381 =head1 OVERVIEW
 382
 383 TODO
 384
 385 =head1 FUNCTIONS
 386
 387 =over 4
 388
 389 =item C<empty_record_list>
 390
 391 Returns a rendered version (actually an instance of
 392 L<SL::Presenter::EscapedText>) of an empty list of records. Is usually
 393 only called by L<grouped_record_list> if its list is empty.
 394
 395 =item C<grouped_record_list $list, %params>
 396
 397 Given a number of Rose::DB objects in the array reference C<$list>
 398 this function first groups them by type. Then it calls L<record_list>
 399 with each non-empty type-specific sub-list and the appropriate
 400 parameters for outputting a list of those records.
 401
 402 Returns a rendered version (actually an instance of
 403 L<SL::Presenter::EscapedText>) of all the lists.
 404
 405 The order in which the records are grouped is:
 406
 407 =over 2
 408
 409 =item * sales quotations
 410
 411 =item * sales orders
 412
 413 =item * sales delivery orders
 414
 415 =item * sales invoices
 416
 417 =item * AR transactions
 418
 419 =item * requests for quotations
 420
 421 =item * purchase orders
 422
 423 =item * purchase delivery orders
 424
 425 =item * purchase invoices
 426
 427 =item * AP transactions
 428
 429 =back
 430
 431 Objects of unknown types are skipped.
 432
 433 Parameters are passed to C<record_list> include C<with_objects> and
 434 C<edit_record_links>.
 435
 436 =item C<record_list $list, %params>
 437
 438 Returns a rendered version (actually an instance of
 439 L<SL::Presenter::EscapedText>) of a list of records. This list
 440 consists of a heading and a tabular representation of the list.
 441
 442 The parameters include:
 443
 444 =over 2
 445
 446 =item C<title>
 447
 448 Mandatory. The title to use in the heading. Must already be
 449 translated.
 450
 451 =item C<columns>
 452
 453 Mandatory. An array reference of column specs to output. Each column
 454 spec can be either an array reference or a hash reference.
 455
 456 If a column spec is an array reference then the first element is the
 457 column's name shown in the table header. It must already be translated.
 458
 459 The second element can be either a string or a code reference. A
 460 string is taken as the name of a function to call on the Rose::DB
 461 object for the current row. Its return value is formatted depending on
 462 the column's type (e.g. dates are output as the user expects them,
 463 floating point numbers are rounded to two decimal places and
 464 right-aligned etc). If it is a code reference then that code is called
 465 with the object as the first argument. Its return value should be an
 466 instance of L<SL::Presenter::EscapedText> and contain the rendered
 467 representation of the content to output.
 468
 469 The third element, if present, can be a link to which the column will
 470 be linked.
 471
 472 If the column spec is a hash reference then the same arguments are
 473 expected. The corresponding hash keys are C<title>, C<data> and
 474 C<link>.
 475
 476 =item C<with_columns>
 477
 478 Can be set by the caller to indicate additional columns to
 479 list. Currently supported:
 480
 481 =over 2
 482
 483 =item C<record_link_destination>
 484
 485 The record link destination. Requires that the records to list have
 486 been retrieved via the L<SL::DB::Helper::LinkedRecords> helper.
 487
 488 =back
 489
 490 =item C<edit_record_links>
 491
 492 If trueish additional controls will be rendered that allow the user to
 493 remove and add record links. Requires that the records to list have
 494 been retrieved via the L<SL::DB::Helper::LinkedRecords> helper.
 495
 496 =back
 497
 498 =back
 499
 500 =head1 BUGS
 501
 502 Nothing here yet.
 503
 504 =head1 AUTHOR
 505
 506 Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>
 507
 508 =cut