1 package SL::Presenter::Record;
 
   5 use parent qw(Exporter);
 
   7 use Exporter qw(import);
 
   8 our @EXPORT = qw(grouped_record_list empty_record_list record_list);
 
  13 use List::Util qw(first);
 
  17   return []     if !defined $array;
 
  18   return $array if ref $array;
 
  22 sub grouped_record_list {
 
  23   my ($self, $list, %params) = @_;
 
  25   %params    = map { exists $params{$_} ? ($_ => $params{$_}) : () } qw(edit_record_links with_columns object_id object_model);
 
  27   my %groups = _sort_grouped_lists(_group_records($list));
 
  30   $output .= _requirement_spec_list(       $self, $groups{requirement_specs},        %params) if $groups{requirement_specs};
 
  31   $output .= _sales_quotation_list(        $self, $groups{sales_quotations},         %params) if $groups{sales_quotations};
 
  32   $output .= _sales_order_list(            $self, $groups{sales_orders},             %params) if $groups{sales_orders};
 
  33   $output .= _sales_delivery_order_list(   $self, $groups{sales_delivery_orders},    %params) if $groups{sales_delivery_orders};
 
  34   $output .= _sales_invoice_list(          $self, $groups{sales_invoices},           %params) if $groups{sales_invoices};
 
  35   $output .= _ar_transaction_list(         $self, $groups{ar_transactions},          %params) if $groups{ar_transactions};
 
  37   $output .= _request_quotation_list(      $self, $groups{purchase_quotations},      %params) if $groups{purchase_quotations};
 
  38   $output .= _purchase_order_list(         $self, $groups{purchase_orders},          %params) if $groups{purchase_orders};
 
  39   $output .= _purchase_delivery_order_list($self, $groups{purchase_delivery_orders}, %params) if $groups{purchase_delivery_orders};
 
  40   $output .= _purchase_invoice_list(       $self, $groups{purchase_invoices},        %params) if $groups{purchase_invoices};
 
  41   $output .= _ap_transaction_list(         $self, $groups{ap_transactions},          %params) if $groups{ap_transactions};
 
  43   $output .= _sepa_collection_list(        $self, $groups{sepa_collections},         %params) if $groups{sepa_collections};
 
  44   $output .= _sepa_transfer_list(          $self, $groups{sepa_transfers},           %params) if $groups{sepa_transfers};
 
  46   $output  = $self->render('presenter/record/grouped_record_list', %params, output => $output);
 
  51 sub empty_record_list {
 
  52   my ($self, %params) = @_;
 
  53   return $self->grouped_record_list([], %params);
 
  57   my ($self, $list, %params) = @_;
 
  61   if (ref($params{columns}) eq 'ARRAY') {
 
  63       if (ref($_) eq 'ARRAY') {
 
  64         { title => $_->[0], data => $_->[1], link => $_->[2] }
 
  68     } @{ delete $params{columns} };
 
  71     croak "Wrong type for 'columns' argument: not an array reference";
 
  74   my %with_columns = map { ($_ => 1) } @{ _arrayify($params{with_columns}) };
 
  75   if ($with_columns{record_link_direction}) {
 
  77       title => $::locale->text('Link direction'),
 
  79           $_[0]->{_record_link_depth} > 1
 
  80         ? $::locale->text('Row was linked to another record')
 
  81         : $_[0]->{_record_link_direction} eq 'from'
 
  82         ? $::locale->text('Row was source for current record')
 
  83         : $::locale->text('Row was created from current record') },
 
  87   my %column_meta   = map { $_->name => $_ } @{ $list->[0]->meta->columns       };
 
  88   my %relationships = map { $_->name => $_ } @{ $list->[0]->meta->relationships };
 
  91     my ($obj, $method, @args) = @_;
 
  96   foreach my $obj (@{ $list }) {
 
  99     foreach my $spec (@columns) {
 
 102       my $method       =  $spec->{column} || $spec->{data};
 
 103       my $meta         =  $column_meta{ $spec->{data} };
 
 104       my $type         =  ref $meta;
 
 105       my $relationship =  $relationships{ $spec->{data} };
 
 106       my $rel_type     =  !$relationship ? '' : $relationship->class;
 
 107       $rel_type        =~ s/^SL::DB:://;
 
 108       $rel_type        =  SL::Util::snakify($rel_type);
 
 110       if (ref($spec->{data}) eq 'CODE') {
 
 111         $cell{value} = $spec->{data}->($obj);
 
 114         $cell{value} = $rel_type && $self->can($rel_type)                                       ? $self->$rel_type($obj->$method, display => 'table-cell')
 
 115                      : $type eq 'Rose::DB::Object::Metadata::Column::Date'                      ? $call->($obj, $method . '_as_date')
 
 116                      : $type =~ m/^Rose::DB::Object::Metadata::Column::(?:Float|Numeric|Real)$/ ? $::form->format_amount(\%::myconfig, $call->($obj, $method), 2)
 
 117                      : $type eq 'Rose::DB::Object::Metadata::Column::Boolean'                   ? $call->($obj, $method . '_as_bool_yn')
 
 118                      : $type =~ m/^Rose::DB::Object::Metadata::Column::(?:Integer|Serial)$/     ? $spec->{data} * 1
 
 119                      :                                                                            $call->($obj, $method);
 
 122       $cell{alignment} = 'right' if $type =~ m/int|serial|float|real|numeric/;
 
 127     push @data, { columns => \@row, record_link => $obj->{_record_link} };
 
 131     map +{ value     => $columns[$_]->{title},
 
 132            alignment => $data[0]->{columns}->[$_]->{alignment},
 
 133          }, (0..scalar(@columns) - 1);
 
 135   return $self->render(
 
 136     'presenter/record/record_list',
 
 138     TABLE_HEADER => \@header,
 
 139     TABLE_ROWS   => \@data,
 
 151     requirement_specs        => sub { (ref($_[0]) eq 'SL::DB::RequirementSpec')                                         },
 
 152     sales_quotations         => sub { (ref($_[0]) eq 'SL::DB::Order')           &&  $_[0]->is_type('sales_quotation')   },
 
 153     sales_orders             => sub { (ref($_[0]) eq 'SL::DB::Order')           &&  $_[0]->is_type('sales_order')       },
 
 154     sales_delivery_orders    => sub { (ref($_[0]) eq 'SL::DB::DeliveryOrder')   &&  $_[0]->is_sales                     },
 
 155     sales_invoices           => sub { (ref($_[0]) eq 'SL::DB::Invoice')         &&  $_[0]->invoice                      },
 
 156     ar_transactions          => sub { (ref($_[0]) eq 'SL::DB::Invoice')         && !$_[0]->invoice                      },
 
 157     purchase_quotations      => sub { (ref($_[0]) eq 'SL::DB::Order')           &&  $_[0]->is_type('request_quotation') },
 
 158     purchase_orders          => sub { (ref($_[0]) eq 'SL::DB::Order')           &&  $_[0]->is_type('purchase_order')    },
 
 159     purchase_delivery_orders => sub { (ref($_[0]) eq 'SL::DB::DeliveryOrder')   && !$_[0]->is_sales                     },
 
 160     purchase_invoices        => sub { (ref($_[0]) eq 'SL::DB::PurchaseInvoice') &&  $_[0]->invoice                      },
 
 161     ap_transactions          => sub { (ref($_[0]) eq 'SL::DB::PurchaseInvoice') && !$_[0]->invoice                      },
 
 162     sepa_collections         => sub { (ref($_[0]) eq 'SL::DB::SepaExportItem')  &&  $_[0]->ar_id                        },
 
 163     sepa_transfers           => sub { (ref($_[0]) eq 'SL::DB::SepaExportItem')  &&  $_[0]->ap_id                        },
 
 168   foreach my $record (@{ $list || [] }) {
 
 169     my $type         = (first { $matchers{$_}->($record) } keys %matchers) || 'other';
 
 170     $groups{$type} ||= [];
 
 171     push @{ $groups{$type} }, $record;
 
 177 sub _sort_grouped_lists {
 
 180   foreach my $group (keys %groups) {
 
 181     next unless @{ $groups{$group} };
 
 182     if ($groups{$group}->[0]->can('compare_to')) {
 
 183       $groups{$group} = [ sort { $a->compare_to($b)    } @{ $groups{$group} } ];
 
 185       $groups{$group} = [ sort { $a->date <=> $b->date } @{ $groups{$group} } ];
 
 192 sub _requirement_spec_list {
 
 193   my ($self, $list, %params) = @_;
 
 195   return $self->record_list(
 
 197     title   => $::locale->text('Requirement specs'),
 
 198     type    => 'requirement_spec',
 
 200       [ $::locale->text('Requirement spec number'), sub { $self->requirement_spec($_[0], display => 'table-cell') } ],
 
 201       [ $::locale->text('Customer'),                'customer'                                                      ],
 
 202       [ $::locale->text('Title'),                   'title'                                                         ],
 
 203       [ $::locale->text('Project'),                 'project',                                                      ],
 
 204       [ $::locale->text('Status'),                  sub { $_[0]->status->description }                              ],
 
 210 sub _sales_quotation_list {
 
 211   my ($self, $list, %params) = @_;
 
 213   return $self->record_list(
 
 215     title   => $::locale->text('Sales Quotations'),
 
 216     type    => 'sales_quotation',
 
 218       [ $::locale->text('Quotation Date'),          'transdate'                                                                ],
 
 219       [ $::locale->text('Quotation Number'),        sub { $self->sales_quotation($_[0], display => 'table-cell') }   ],
 
 220       [ $::locale->text('Customer'),                'customer'                                                                 ],
 
 221       [ $::locale->text('Net amount'),              'netamount'                                                                ],
 
 222       [ $::locale->text('Transaction description'), 'transaction_description'                                                  ],
 
 223       [ $::locale->text('Project'),                 'globalproject', ],
 
 224       [ $::locale->text('Closed'),                  'closed'                                                                   ],
 
 230 sub _request_quotation_list {
 
 231   my ($self, $list, %params) = @_;
 
 233   return $self->record_list(
 
 235     title   => $::locale->text('Request Quotations'),
 
 236     type    => 'request_quotation',
 
 238       [ $::locale->text('Quotation Date'),          'transdate'                                                                ],
 
 239       [ $::locale->text('Quotation Number'),        sub { $self->request_quotation($_[0], display => 'table-cell') }   ],
 
 240       [ $::locale->text('Vendor'),                  'vendor'                                                                   ],
 
 241       [ $::locale->text('Net amount'),              'netamount'                                                                ],
 
 242       [ $::locale->text('Transaction description'), 'transaction_description'                                                  ],
 
 243       [ $::locale->text('Project'),                 'globalproject', ],
 
 244       [ $::locale->text('Closed'),                  'closed'                                                                   ],
 
 250 sub _sales_order_list {
 
 251   my ($self, $list, %params) = @_;
 
 253   return $self->record_list(
 
 255     title   => $::locale->text('Sales Orders'),
 
 256     type    => 'sales_order',
 
 258       [ $::locale->text('Order Date'),              'transdate'                                                                ],
 
 259       [ $::locale->text('Order Number'),            sub { $self->sales_order($_[0], display => 'table-cell') }   ],
 
 260       [ $::locale->text('Quotation'),               'quonumber' ],
 
 261       [ $::locale->text('Customer'),                'customer'                                                                 ],
 
 262       [ $::locale->text('Net amount'),              'netamount'                                                                ],
 
 263       [ $::locale->text('Transaction description'), 'transaction_description'                                                  ],
 
 264       [ $::locale->text('Project'),                 'globalproject', ],
 
 265       [ $::locale->text('Closed'),                  'closed'                                                                   ],
 
 271 sub _purchase_order_list {
 
 272   my ($self, $list, %params) = @_;
 
 274   return $self->record_list(
 
 276     title   => $::locale->text('Purchase Orders'),
 
 277     type    => 'purchase_order',
 
 279       [ $::locale->text('Order Date'),              'transdate'                                                                ],
 
 280       [ $::locale->text('Order Number'),            sub { $self->purchase_order($_[0], display => 'table-cell') }   ],
 
 281       [ $::locale->text('Request for Quotation'),   'quonumber' ],
 
 282       [ $::locale->text('Vendor'),                  'vendor'                                                                 ],
 
 283       [ $::locale->text('Net amount'),              'netamount'                                                                ],
 
 284       [ $::locale->text('Transaction description'), 'transaction_description'                                                  ],
 
 285       [ $::locale->text('Project'),                 'globalproject', ],
 
 286       [ $::locale->text('Closed'),                  'closed'                                                                   ],
 
 292 sub _sales_delivery_order_list {
 
 293   my ($self, $list, %params) = @_;
 
 295   return $self->record_list(
 
 297     title   => $::locale->text('Sales Delivery Orders'),
 
 298     type    => 'sales_delivery_order',
 
 300       [ $::locale->text('Delivery Order Date'),     'transdate'                                                                ],
 
 301       [ $::locale->text('Delivery Order Number'),   sub { $self->sales_delivery_order($_[0], display => 'table-cell') } ],
 
 302       [ $::locale->text('Order Number'),            'ordnumber' ],
 
 303       [ $::locale->text('Customer'),                'customer'                                                                 ],
 
 304       [ $::locale->text('Transaction description'), 'transaction_description'                                                  ],
 
 305       [ $::locale->text('Project'),                 'globalproject', ],
 
 306       [ $::locale->text('Delivered'),               'delivered'                                                                ],
 
 307       [ $::locale->text('Closed'),                  'closed'                                                                   ],
 
 313 sub _purchase_delivery_order_list {
 
 314   my ($self, $list, %params) = @_;
 
 316   return $self->record_list(
 
 318     title   => $::locale->text('Purchase Delivery Orders'),
 
 319     type    => 'purchase_delivery_order',
 
 321       [ $::locale->text('Delivery Order Date'),     'transdate'                                                                ],
 
 322       [ $::locale->text('Delivery Order Number'),   sub { $self->purchase_delivery_order($_[0], display => 'table-cell') } ],
 
 323       [ $::locale->text('Order Number'),            'ordnumber' ],
 
 324       [ $::locale->text('Vendor'),                  'vendor'                                                                 ],
 
 325       [ $::locale->text('Transaction description'), 'transaction_description'                                                  ],
 
 326       [ $::locale->text('Project'),                 'globalproject', ],
 
 327       [ $::locale->text('Delivered'),               'delivered'                                                                ],
 
 328       [ $::locale->text('Closed'),                  'closed'                                                                   ],
 
 334 sub _sales_invoice_list {
 
 335   my ($self, $list, %params) = @_;
 
 337   return $self->record_list(
 
 339     title   => $::locale->text('Sales Invoices'),
 
 340     type    => 'sales_invoice',
 
 342       [ $::locale->text('Invoice Date'),            'transdate'               ],
 
 343       [ $::locale->text('Type'),                    sub { $_[0]->displayable_type } ],
 
 344       [ $::locale->text('Invoice Number'),          sub { $self->sales_invoice($_[0], display => 'table-cell') } ],
 
 345       [ $::locale->text('Quotation Number'),        'quonumber' ],
 
 346       [ $::locale->text('Order Number'),            'ordnumber' ],
 
 347       [ $::locale->text('Customer'),                'customer'                ],
 
 348       [ $::locale->text('Net amount'),              'netamount'               ],
 
 349       [ $::locale->text('Paid'),                    'paid'                    ],
 
 350       [ $::locale->text('Transaction description'), 'transaction_description' ],
 
 356 sub _purchase_invoice_list {
 
 357   my ($self, $list, %params) = @_;
 
 359   return $self->record_list(
 
 361     title   => $::locale->text('Purchase Invoices'),
 
 362     type    => 'purchase_invoice',
 
 364       [ $::locale->text('Invoice Date'),                 'transdate'               ],
 
 365       [ $::locale->text('Invoice Number'),               sub { $self->purchase_invoice($_[0], display => 'table-cell') } ],
 
 366       [ $::locale->text('Request for Quotation Number'), 'quonumber' ],
 
 367       [ $::locale->text('Order Number'),                 'ordnumber' ],
 
 368       [ $::locale->text('Vendor'),                       'vendor'                 ],
 
 369       [ $::locale->text('Net amount'),                   'netamount'               ],
 
 370       [ $::locale->text('Paid'),                         'paid'                    ],
 
 371       [ $::locale->text('Transaction description'),      'transaction_description' ],
 
 377 sub _ar_transaction_list {
 
 378   my ($self, $list, %params) = @_;
 
 380   return $self->record_list(
 
 382     title   => $::locale->text('AR Transactions'),
 
 383     type    => 'ar_transaction',
 
 385       [ $::locale->text('Invoice Date'),            'transdate'               ],
 
 386       [ $::locale->text('Type'),                    sub { $_[0]->displayable_type } ],
 
 387       [ $::locale->text('Invoice Number'),          sub { $self->ar_transaction($_[0], display => 'table-cell') } ],
 
 388       [ $::locale->text('Customer'),                'customer'                ],
 
 389       [ $::locale->text('Net amount'),              'netamount'               ],
 
 390       [ $::locale->text('Paid'),                    'paid'                    ],
 
 391       [ $::locale->text('Transaction description'), 'transaction_description' ],
 
 397 sub _ap_transaction_list {
 
 398   my ($self, $list, %params) = @_;
 
 400   return $self->record_list(
 
 402     title   => $::locale->text('AP Transactions'),
 
 403     type    => 'ap_transaction',
 
 405       [ $::locale->text('Invoice Date'),            'transdate'                      ],
 
 406       [ $::locale->text('Invoice Number'),          sub { $self->ap_transaction($_[0 ], display => 'table-cell') } ],
 
 407       [ $::locale->text('Vendor'),                  'vendor'                         ],
 
 408       [ $::locale->text('Net amount'),              'netamount'                      ],
 
 409       [ $::locale->text('Paid'),                    'paid'                           ],
 
 410       [ $::locale->text('Transaction description'), 'transaction_description'        ],
 
 416 sub _sepa_export_list {
 
 417   my ($self, $list, %params) = @_;
 
 419   my ($source, $destination) = $params{type} eq 'sepa_transfer' ? qw(our vc)                                 : qw(vc our);
 
 420   $params{title}             = $params{type} eq 'sepa_transfer' ? $::locale->text('Bank transfers via SEPA') : $::locale->text('Bank collections via SEPA');
 
 421   $params{with_columns}      = [ grep { $_ ne 'record_link_direction' } @{ $params{with_columns} || [] } ];
 
 423   delete $params{edit_record_links};
 
 425   return $self->record_list(
 
 428       [ $::locale->text('Export Number'),    'sepa_export',                                  ],
 
 429       [ $::locale->text('Execution date'),   'execution_date'                                ],
 
 430       [ $::locale->text('Export date'),      sub { $_[0]->sepa_export->itime->to_kivitendo } ],
 
 431       [ $::locale->text('Source BIC'),       "${source}_bic"                                 ],
 
 432       [ $::locale->text('Source IBAN'),      "${source}_iban"                                ],
 
 433       [ $::locale->text('Destination BIC'),  "${destination}_bic"                            ],
 
 434       [ $::locale->text('Destination IBAN'), "${destination}_iban"                           ],
 
 435       [ $::locale->text('Amount'),           'amount'                                        ],
 
 441 sub _sepa_transfer_list {
 
 442   my ($self, $list, %params) = @_;
 
 443   _sepa_export_list($self, $list, %params, type => 'sepa_transfer');
 
 446 sub _sepa_collection_list {
 
 447   my ($self, $list, %params) = @_;
 
 448   _sepa_export_list($self, $list, %params, type => 'sepa_collection');
 
 461 SL::Presenter::Record - Presenter module for lists of
 
 462 sales/purchase/general ledger record Rose::DB objects
 
 466   # Retrieve a number of documents from somewhere, e.g.
 
 467   my $order   = SL::DB::Manager::Order->get_first(where => [ SL::DB::Manager::Order->type_filter('sales_order') ]);
 
 468   my $records = $order->linked_records(destination => 'to');
 
 470   # Give HTML representation:
 
 471   my $html = SL::Presenter->get->grouped_record_list($records);
 
 481 =item C<empty_record_list>
 
 483 Returns a rendered version (actually an instance of
 
 484 L<SL::Presenter::EscapedText>) of an empty list of records. Is usually
 
 485 only called by L<grouped_record_list> if its list is empty.
 
 487 =item C<grouped_record_list $list, %params>
 
 489 Given a number of Rose::DB objects in the array reference C<$list>
 
 490 this function first groups them by type. Then it calls L<record_list>
 
 491 with each non-empty type-specific sub-list and the appropriate
 
 492 parameters for outputting a list of those records.
 
 494 Returns a rendered version (actually an instance of
 
 495 L<SL::Presenter::EscapedText>) of all the lists.
 
 497 The order in which the records are grouped is:
 
 501 =item * sales quotations
 
 505 =item * sales delivery orders
 
 507 =item * sales invoices
 
 509 =item * AR transactions
 
 511 =item * requests for quotations
 
 513 =item * purchase orders
 
 515 =item * purchase delivery orders
 
 517 =item * purchase invoices
 
 519 =item * AP transactions
 
 521 =item * SEPA collections
 
 523 =item * SEPA transfers
 
 527 Objects of unknown types are skipped.
 
 529 Parameters are passed to C<record_list> include C<with_objects> and
 
 530 C<edit_record_links>.
 
 532 =item C<record_list $list, %params>
 
 534 Returns a rendered version (actually an instance of
 
 535 L<SL::Presenter::EscapedText>) of a list of records. This list
 
 536 consists of a heading and a tabular representation of the list.
 
 538 The parameters include:
 
 544 Mandatory. The title to use in the heading. Must already be
 
 549 Mandatory. An array reference of column specs to output. Each column
 
 550 spec can be either an array reference or a hash reference.
 
 552 If a column spec is an array reference then the first element is the
 
 553 column's name shown in the table header. It must already be translated.
 
 555 The second element can be either a string or a code reference. A
 
 556 string is taken as the name of a function to call on the Rose::DB
 
 557 object for the current row. Its return value is formatted depending on
 
 558 the column's type (e.g. dates are output as the user expects them,
 
 559 floating point numbers are rounded to two decimal places and
 
 560 right-aligned etc). If it is a code reference then that code is called
 
 561 with the object as the first argument. Its return value should be an
 
 562 instance of L<SL::Presenter::EscapedText> and contain the rendered
 
 563 representation of the content to output.
 
 565 The third element, if present, can be a link to which the column will
 
 568 If the column spec is a hash reference then the same arguments are
 
 569 expected. The corresponding hash keys are C<title>, C<data> and
 
 572 =item C<with_columns>
 
 574 Can be set by the caller to indicate additional columns to
 
 575 be listed. Currently supported:
 
 579 =item C<record_link_destination>
 
 581 The record link destination. Requires that the records to be listed have
 
 582 been retrieved via the L<SL::DB::Helper::LinkedRecords> helper.
 
 586 =item C<edit_record_links>
 
 588 If trueish additional controls will be rendered that allow the user to
 
 589 remove and add record links. Requires that the records to be listed have
 
 590 been retrieved via the L<SL::DB::Helper::LinkedRecords> helper.
 
 602 Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>