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