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