Dialogbuchung - Buchen, Storno und Löschen protokollieren
[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 .= _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};
36
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};
42
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};
45
46   $output  = $self->render('presenter/record/grouped_record_list', %params, output => $output);
47
48   return $output;
49 }
50
51 sub empty_record_list {
52   my ($self, %params) = @_;
53   return $self->grouped_record_list([], %params);
54 }
55
56 sub record_list {
57   my ($self, $list, %params) = @_;
58
59   my @columns;
60
61   if (ref($params{columns}) eq 'ARRAY') {
62     @columns = map {
63       if (ref($_) eq 'ARRAY') {
64         { title => $_->[0], data => $_->[1], link => $_->[2] }
65       } else {
66         $_;
67       }
68     } @{ delete $params{columns} };
69
70   } else {
71     croak "Wrong type for 'columns' argument: not an array reference";
72   }
73
74   my %with_columns = map { ($_ => 1) } @{ _arrayify($params{with_columns}) };
75   if ($with_columns{record_link_direction}) {
76     push @columns, {
77       title => $::locale->text('Link direction'),
78       data  => sub {
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') },
84     };
85   }
86
87   my %column_meta   = map { $_->name => $_ } @{ $list->[0]->meta->columns       };
88   my %relationships = map { $_->name => $_ } @{ $list->[0]->meta->relationships };
89
90   my $call = sub {
91     my ($obj, $method, @args) = @_;
92     $obj->$method(@args);
93   };
94
95   my @data;
96   foreach my $obj (@{ $list }) {
97     my @row;
98
99     foreach my $spec (@columns) {
100       my %cell;
101
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);
109
110       if (ref($spec->{data}) eq 'CODE') {
111         $cell{value} = $spec->{data}->($obj);
112
113       } else {
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);
120       }
121
122       $cell{alignment} = 'right' if $type =~ m/int|serial|float|real|numeric/;
123
124       push @row, \%cell;
125     }
126
127     push @data, { columns => \@row, record_link => $obj->{_record_link} };
128   }
129
130   my @header =
131     map +{ value     => $columns[$_]->{title},
132            alignment => $data[0]->{columns}->[$_]->{alignment},
133          }, (0..scalar(@columns) - 1);
134
135   return $self->render(
136     'presenter/record/record_list',
137     %params,
138     TABLE_HEADER => \@header,
139     TABLE_ROWS   => \@data,
140   );
141 }
142
143 #
144 # private methods
145 #
146
147 sub _group_records {
148   my ($list) = @_;
149
150   my %matchers = (
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                        },
164   );
165
166   my %groups;
167
168   foreach my $record (@{ $list || [] }) {
169     my $type         = (first { $matchers{$_}->($record) } keys %matchers) || 'other';
170     $groups{$type} ||= [];
171     push @{ $groups{$type} }, $record;
172   }
173
174   return %groups;
175 }
176
177 sub _sort_grouped_lists {
178   my (%groups) = @_;
179
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} } ];
184     } else {
185       $groups{$group} = [ sort { $a->date <=> $b->date } @{ $groups{$group} } ];
186     }
187   }
188
189   return %groups;
190 }
191
192 sub _requirement_spec_list {
193   my ($self, $list, %params) = @_;
194
195   return $self->record_list(
196     $list,
197     title   => $::locale->text('Requirement specs'),
198     type    => 'requirement_spec',
199     columns => [
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 }                              ],
205     ],
206     %params,
207   );
208 }
209
210 sub _sales_quotation_list {
211   my ($self, $list, %params) = @_;
212
213   return $self->record_list(
214     $list,
215     title   => $::locale->text('Sales Quotations'),
216     type    => 'sales_quotation',
217     columns => [
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'                                                                   ],
225     ],
226     %params,
227   );
228 }
229
230 sub _request_quotation_list {
231   my ($self, $list, %params) = @_;
232
233   return $self->record_list(
234     $list,
235     title   => $::locale->text('Request Quotations'),
236     type    => 'request_quotation',
237     columns => [
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'                                                                   ],
245     ],
246     %params,
247   );
248 }
249
250 sub _sales_order_list {
251   my ($self, $list, %params) = @_;
252
253   return $self->record_list(
254     $list,
255     title   => $::locale->text('Sales Orders'),
256     type    => 'sales_order',
257     columns => [
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'                                                                   ],
266     ],
267     %params,
268   );
269 }
270
271 sub _purchase_order_list {
272   my ($self, $list, %params) = @_;
273
274   return $self->record_list(
275     $list,
276     title   => $::locale->text('Purchase Orders'),
277     type    => 'purchase_order',
278     columns => [
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'                                                                   ],
287     ],
288     %params,
289   );
290 }
291
292 sub _sales_delivery_order_list {
293   my ($self, $list, %params) = @_;
294
295   return $self->record_list(
296     $list,
297     title   => $::locale->text('Sales Delivery Orders'),
298     type    => 'sales_delivery_order',
299     columns => [
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'                                                                   ],
308     ],
309     %params,
310   );
311 }
312
313 sub _purchase_delivery_order_list {
314   my ($self, $list, %params) = @_;
315
316   return $self->record_list(
317     $list,
318     title   => $::locale->text('Purchase Delivery Orders'),
319     type    => 'purchase_delivery_order',
320     columns => [
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'                                                                   ],
329     ],
330     %params,
331   );
332 }
333
334 sub _sales_invoice_list {
335   my ($self, $list, %params) = @_;
336
337   return $self->record_list(
338     $list,
339     title   => $::locale->text('Sales Invoices'),
340     type    => 'sales_invoice',
341     columns => [
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' ],
351     ],
352     %params,
353   );
354 }
355
356 sub _purchase_invoice_list {
357   my ($self, $list, %params) = @_;
358
359   return $self->record_list(
360     $list,
361     title   => $::locale->text('Purchase Invoices'),
362     type    => 'purchase_invoice',
363     columns => [
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' ],
372     ],
373     %params,
374   );
375 }
376
377 sub _ar_transaction_list {
378   my ($self, $list, %params) = @_;
379
380   return $self->record_list(
381     $list,
382     title   => $::locale->text('AR Transactions'),
383     type    => 'ar_transaction',
384     columns => [
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' ],
392     ],
393     %params,
394   );
395 }
396
397 sub _ap_transaction_list {
398   my ($self, $list, %params) = @_;
399
400   return $self->record_list(
401     $list,
402     title   => $::locale->text('AP Transactions'),
403     type    => 'ap_transaction',
404     columns => [
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'        ],
411     ],
412     %params,
413   );
414 }
415
416 sub _sepa_export_list {
417   my ($self, $list, %params) = @_;
418
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} || [] } ];
422
423   delete $params{edit_record_links};
424
425   return $self->record_list(
426     $list,
427     columns => [
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'                                        ],
436     ],
437     %params,
438   );
439 }
440
441 sub _sepa_transfer_list {
442   my ($self, $list, %params) = @_;
443   _sepa_export_list($self, $list, %params, type => 'sepa_transfer');
444 }
445
446 sub _sepa_collection_list {
447   my ($self, $list, %params) = @_;
448   _sepa_export_list($self, $list, %params, type => 'sepa_collection');
449 }
450
451 1;
452
453 __END__
454
455 =pod
456
457 =encoding utf8
458
459 =head1 NAME
460
461 SL::Presenter::Record - Presenter module for lists of
462 sales/purchase/general ledger record Rose::DB objects
463
464 =head1 SYNOPSIS
465
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');
469
470   # Give HTML representation:
471   my $html = SL::Presenter->get->grouped_record_list($records);
472
473 =head1 OVERVIEW
474
475 TODO
476
477 =head1 FUNCTIONS
478
479 =over 4
480
481 =item C<empty_record_list>
482
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.
486
487 =item C<grouped_record_list $list, %params>
488
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.
493
494 Returns a rendered version (actually an instance of
495 L<SL::Presenter::EscapedText>) of all the lists.
496
497 The order in which the records are grouped is:
498
499 =over 2
500
501 =item * sales quotations
502
503 =item * sales orders
504
505 =item * sales delivery orders
506
507 =item * sales invoices
508
509 =item * AR transactions
510
511 =item * requests for quotations
512
513 =item * purchase orders
514
515 =item * purchase delivery orders
516
517 =item * purchase invoices
518
519 =item * AP transactions
520
521 =item * SEPA collections
522
523 =item * SEPA transfers
524
525 =back
526
527 Objects of unknown types are skipped.
528
529 Parameters are passed to C<record_list> include C<with_objects> and
530 C<edit_record_links>.
531
532 =item C<record_list $list, %params>
533
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.
537
538 The parameters include:
539
540 =over 2
541
542 =item C<title>
543
544 Mandatory. The title to use in the heading. Must already be
545 translated.
546
547 =item C<columns>
548
549 Mandatory. An array reference of column specs to output. Each column
550 spec can be either an array reference or a hash reference.
551
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.
554
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.
564
565 The third element, if present, can be a link to which the column will
566 be linked.
567
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
570 C<link>.
571
572 =item C<with_columns>
573
574 Can be set by the caller to indicate additional columns to
575 be listed. Currently supported:
576
577 =over 2
578
579 =item C<record_link_destination>
580
581 The record link destination. Requires that the records to be listed have
582 been retrieved via the L<SL::DB::Helper::LinkedRecords> helper.
583
584 =back
585
586 =item C<edit_record_links>
587
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.
591
592 =back
593
594 =back
595
596 =head1 BUGS
597
598 Nothing here yet.
599
600 =head1 AUTHOR
601
602 Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>
603
604 =cut