Merge branch 'currency'
[kivitendo-erp.git] / 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