1 package SL::Presenter::Record;
6 use SL::Presenter::EscapedText qw(escape is_escaped);
8 use Exporter qw(import);
9 our @EXPORT_OK = qw(grouped_record_list empty_record_list record_list record);
14 use List::Util qw(first);
18 return [] if !defined $array;
19 return $array if ref $array;
24 my ($record, %params) = @_;
26 my %grouped = _group_records( [ $record ] ); # pass $record as arrayref
27 my $type = (keys %grouped)[0];
29 $record->presenter->sales_invoice( $record, %params) if $type eq 'sales_invoices';
30 $record->presenter->purchase_invoice($record, %params) if $type eq 'purchase_invoices';
31 $record->presenter->ar_transaction( $record, %params) if $type eq 'ar_transactions';
32 $record->presenter->ap_transaction( $record, %params) if $type eq 'ap_transactions';
33 $record->presenter->gl_transaction( $record, %params) if $type eq 'gl_transactions';
38 sub grouped_record_list {
39 my ($list, %params) = @_;
41 %params = map { exists $params{$_} ? ($_ => $params{$_}) : () } qw(edit_record_links with_columns object_id object_model);
43 my %groups = _sort_grouped_lists(_group_records($list));
46 $output .= _requirement_spec_list( $groups{requirement_specs}, %params) if $groups{requirement_specs};
47 $output .= _shop_order_list( $groups{shop_orders}, %params) if $groups{shop_orders};
48 $output .= _sales_quotation_list( $groups{sales_quotations}, %params) if $groups{sales_quotations};
49 $output .= _sales_order_list( $groups{sales_orders}, %params) if $groups{sales_orders};
50 $output .= _sales_delivery_order_list( $groups{sales_delivery_orders}, %params) if $groups{sales_delivery_orders};
51 $output .= _sales_invoice_list( $groups{sales_invoices}, %params) if $groups{sales_invoices};
52 $output .= _ar_transaction_list( $groups{ar_transactions}, %params) if $groups{ar_transactions};
54 $output .= _request_quotation_list( $groups{purchase_quotations}, %params) if $groups{purchase_quotations};
55 $output .= _purchase_order_list( $groups{purchase_orders}, %params) if $groups{purchase_orders};
56 $output .= _purchase_delivery_order_list($groups{purchase_delivery_orders}, %params) if $groups{purchase_delivery_orders};
57 $output .= _purchase_invoice_list( $groups{purchase_invoices}, %params) if $groups{purchase_invoices};
58 $output .= _ap_transaction_list( $groups{ap_transactions}, %params) if $groups{ap_transactions};
60 $output .= _gl_transaction_list( $groups{gl_transactions}, %params) if $groups{gl_transactions};
62 $output .= _bank_transactions( $groups{bank_transactions}, %params) if $groups{bank_transactions};
64 $output .= _sepa_collection_list( $groups{sepa_collections}, %params) if $groups{sepa_collections};
65 $output .= _sepa_transfer_list( $groups{sepa_transfers}, %params) if $groups{sepa_transfers};
67 $output .= _letter_list( $groups{letters}, %params) if $groups{letters};
69 $output = SL::Presenter->get->render('presenter/record/grouped_record_list', %params, output => $output);
74 sub grouped_list { goto &grouped_record_list }
76 sub empty_record_list {
78 return grouped_record_list([], %params);
81 sub empty_list { goto &empty_record_list }
84 my ($list, %params) = @_;
88 if (ref($params{columns}) eq 'ARRAY') {
90 if (ref($_) eq 'ARRAY') {
91 { title => $_->[0], data => $_->[1], link => $_->[2] }
95 } @{ delete $params{columns} };
98 croak "Wrong type for 'columns' argument: not an array reference";
101 my %with_columns = map { ($_ => 1) } @{ _arrayify($params{with_columns}) };
102 if ($with_columns{record_link_direction}) {
104 title => $::locale->text('Link direction'),
106 $_[0]->{_record_link_depth} > 1
107 ? $::locale->text('Row was linked to another record')
108 : $_[0]->{_record_link_direction} eq 'from'
109 ? $::locale->text('Row was source for current record')
110 : $::locale->text('Row was created from current record') },
114 my %column_meta = map { $_->name => $_ } @{ $list->[0]->meta->columns };
115 my %relationships = map { $_->name => $_ } @{ $list->[0]->meta->relationships };
118 my ($obj, $method, @args) = @_;
119 $obj->$method(@args);
123 foreach my $obj (@{ $list }) {
126 foreach my $spec (@columns) {
129 my $method = $spec->{column} || $spec->{data};
130 my $meta = $column_meta{ $spec->{data} };
131 my $type = ref $meta;
132 my $relationship = $relationships{ $spec->{data} };
133 my $rel_type = !$relationship ? '' : $relationship->class;
134 $rel_type =~ s/^SL::DB:://;
135 $rel_type = SL::Util::snakify($rel_type);
137 if (ref($spec->{data}) eq 'CODE') {
138 $cell{value} = $spec->{data}->($obj);
141 $cell{value} = ref $obj->$method && $obj->$method->isa('SL::DB::Object') && $obj->$method->presenter->can($rel_type) ? $obj->$method->presenter->$rel_type(display => 'table-cell')
142 : $type eq 'Rose::DB::Object::Metadata::Column::Date' ? $call->($obj, $method . '_as_date')
143 : $type =~ m/^Rose::DB::Object::Metadata::Column::(?:Float|Numeric|Real)$/ ? $::form->format_amount(\%::myconfig, $call->($obj, $method), 2)
144 : $type eq 'Rose::DB::Object::Metadata::Column::Boolean' ? $call->($obj, $method . '_as_bool_yn')
145 : $type =~ m/^Rose::DB::Object::Metadata::Column::(?:Integer|Serial)$/ ? $spec->{data} * 1
146 : $call->($obj, $method);
149 $cell{alignment} = 'right' if $type =~ m/int|serial|float|real|numeric/;
154 push @data, { columns => \@row, record_link => $obj->{_record_link} };
158 map +{ value => $columns[$_]->{title},
159 alignment => $data[0]->{columns}->[$_]->{alignment},
160 }, (0..scalar(@columns) - 1);
162 return SL::Presenter->get->render(
163 'presenter/record/record_list',
165 TABLE_HEADER => \@header,
166 TABLE_ROWS => \@data,
170 sub list { goto &record_list }
179 requirement_specs => sub { (ref($_[0]) eq 'SL::DB::RequirementSpec') },
180 shop_orders => sub { (ref($_[0]) eq 'SL::DB::ShopOrder') && $_[0]->id },
181 sales_quotations => sub { (ref($_[0]) eq 'SL::DB::Order') && $_[0]->is_type('sales_quotation') },
182 sales_orders => sub { (ref($_[0]) eq 'SL::DB::Order') && $_[0]->is_type('sales_order') },
183 sales_delivery_orders => sub { (ref($_[0]) eq 'SL::DB::DeliveryOrder') && $_[0]->is_sales },
184 sales_invoices => sub { (ref($_[0]) eq 'SL::DB::Invoice') && $_[0]->invoice },
185 ar_transactions => sub { (ref($_[0]) eq 'SL::DB::Invoice') && !$_[0]->invoice },
186 purchase_quotations => sub { (ref($_[0]) eq 'SL::DB::Order') && $_[0]->is_type('request_quotation') },
187 purchase_orders => sub { (ref($_[0]) eq 'SL::DB::Order') && $_[0]->is_type('purchase_order') },
188 purchase_delivery_orders => sub { (ref($_[0]) eq 'SL::DB::DeliveryOrder') && !$_[0]->is_sales },
189 purchase_invoices => sub { (ref($_[0]) eq 'SL::DB::PurchaseInvoice') && $_[0]->invoice },
190 ap_transactions => sub { (ref($_[0]) eq 'SL::DB::PurchaseInvoice') && !$_[0]->invoice },
191 sepa_collections => sub { (ref($_[0]) eq 'SL::DB::SepaExportItem') && $_[0]->ar_id },
192 sepa_transfers => sub { (ref($_[0]) eq 'SL::DB::SepaExportItem') && $_[0]->ap_id },
193 gl_transactions => sub { (ref($_[0]) eq 'SL::DB::GLTransaction') },
194 bank_transactions => sub { (ref($_[0]) eq 'SL::DB::BankTransaction') && $_[0]->id },
195 letters => sub { (ref($_[0]) eq 'SL::DB::Letter') && $_[0]->id },
200 foreach my $record (@{ $list || [] }) {
201 my $type = (first { $matchers{$_}->($record) } keys %matchers) || 'other';
202 $groups{$type} ||= [];
203 push @{ $groups{$type} }, $record;
209 sub _sort_grouped_lists {
212 foreach my $group (keys %groups) {
213 next unless @{ $groups{$group} };
214 if ($groups{$group}->[0]->can('compare_to')) {
215 $groups{$group} = [ sort { $a->compare_to($b) } @{ $groups{$group} } ];
217 $groups{$group} = [ sort { $a->date <=> $b->date } @{ $groups{$group} } ];
224 sub _requirement_spec_list {
225 my ($list, %params) = @_;
229 title => $::locale->text('Requirement specs'),
230 type => 'requirement_spec',
232 [ $::locale->text('Requirement spec number'), sub { $_[0]->presenter->requirement_spec(display => 'table-cell') } ],
233 [ $::locale->text('Customer'), 'customer' ],
234 [ $::locale->text('Title'), 'title' ],
235 [ $::locale->text('Project'), 'project', ],
236 [ $::locale->text('Status'), sub { $_[0]->status->description } ],
242 sub _shop_order_list {
243 my ($list, %params) = @_;
247 title => $::locale->text('Shop Orders'),
248 type => 'shop_order',
250 [ $::locale->text('Shop Order Date'), sub { $_[0]->order_date->to_kivitendo } ],
251 [ $::locale->text('Shop Order Number'), sub { $_[0]->presenter->shop_order(display => 'table-cell') } ],
252 [ $::locale->text('Transfer Date'), 'transfer_date' ],
253 [ $::locale->text('Amount'), 'amount' ],
259 sub _sales_quotation_list {
260 my ($list, %params) = @_;
264 title => $::locale->text('Sales Quotations'),
265 type => 'sales_quotation',
267 [ $::locale->text('Quotation Date'), 'transdate' ],
268 [ $::locale->text('Quotation Number'), sub { $_[0]->presenter->sales_quotation(display => 'table-cell') } ],
269 [ $::locale->text('Customer'), 'customer' ],
270 [ $::locale->text('Net amount'), 'netamount' ],
271 [ $::locale->text('Transaction description'), 'transaction_description' ],
272 [ $::locale->text('Project'), 'globalproject', ],
273 [ $::locale->text('Closed'), 'closed' ],
279 sub _request_quotation_list {
280 my ($list, %params) = @_;
284 title => $::locale->text('Request Quotations'),
285 type => 'request_quotation',
287 [ $::locale->text('Quotation Date'), 'transdate' ],
288 [ $::locale->text('Quotation Number'), sub { $_[0]->presenter->request_quotation(display => 'table-cell') } ],
289 [ $::locale->text('Vendor'), 'vendor' ],
290 [ $::locale->text('Net amount'), 'netamount' ],
291 [ $::locale->text('Transaction description'), 'transaction_description' ],
292 [ $::locale->text('Project'), 'globalproject', ],
293 [ $::locale->text('Closed'), 'closed' ],
299 sub _sales_order_list {
300 my ($list, %params) = @_;
304 title => $::locale->text('Sales Orders'),
305 type => 'sales_order',
307 [ $::locale->text('Order Date'), 'transdate' ],
308 [ $::locale->text('Order Number'), sub { $_[0]->presenter->sales_order(display => 'table-cell') } ],
309 [ $::locale->text('Quotation'), 'quonumber' ],
310 [ $::locale->text('Customer'), 'customer' ],
311 [ $::locale->text('Net amount'), 'netamount' ],
312 [ $::locale->text('Transaction description'), 'transaction_description' ],
313 [ $::locale->text('Project'), 'globalproject', ],
314 [ $::locale->text('Closed'), 'closed' ],
320 sub _purchase_order_list {
321 my ($list, %params) = @_;
325 title => $::locale->text('Purchase Orders'),
326 type => 'purchase_order',
328 [ $::locale->text('Order Date'), 'transdate' ],
329 [ $::locale->text('Order Number'), sub { $_[0]->presenter->purchase_order(display => 'table-cell') } ],
330 [ $::locale->text('Request for Quotation'), 'quonumber' ],
331 [ $::locale->text('Vendor'), 'vendor' ],
332 [ $::locale->text('Net amount'), 'netamount' ],
333 [ $::locale->text('Transaction description'), 'transaction_description' ],
334 [ $::locale->text('Project'), 'globalproject', ],
335 [ $::locale->text('Closed'), 'closed' ],
341 sub _sales_delivery_order_list {
342 my ($list, %params) = @_;
346 title => $::locale->text('Sales Delivery Orders'),
347 type => 'sales_delivery_order',
349 [ $::locale->text('Delivery Order Date'), 'transdate' ],
350 [ $::locale->text('Delivery Order Number'), sub { $_[0]->presenter->sales_delivery_order(display => 'table-cell') } ],
351 [ $::locale->text('Order Number'), 'ordnumber' ],
352 [ $::locale->text('Customer'), 'customer' ],
353 [ $::locale->text('Transaction description'), 'transaction_description' ],
354 [ $::locale->text('Project'), 'globalproject', ],
355 [ $::locale->text('Delivered'), 'delivered' ],
356 [ $::locale->text('Closed'), 'closed' ],
362 sub _purchase_delivery_order_list {
363 my ($list, %params) = @_;
367 title => $::locale->text('Purchase Delivery Orders'),
368 type => 'purchase_delivery_order',
370 [ $::locale->text('Delivery Order Date'), 'transdate' ],
371 [ $::locale->text('Delivery Order Number'), sub { $_[0]->presenter->purchase_delivery_order(display => 'table-cell') } ],
372 [ $::locale->text('Order Number'), 'ordnumber' ],
373 [ $::locale->text('Vendor'), 'vendor' ],
374 [ $::locale->text('Transaction description'), 'transaction_description' ],
375 [ $::locale->text('Project'), 'globalproject', ],
376 [ $::locale->text('Delivered'), 'delivered' ],
377 [ $::locale->text('Closed'), 'closed' ],
383 sub _sales_invoice_list {
384 my ($list, %params) = @_;
388 title => $::locale->text('Sales Invoices'),
389 type => 'sales_invoice',
391 [ $::locale->text('Invoice Date'), 'transdate' ],
392 [ $::locale->text('Type'), sub { $_[0]->displayable_type } ],
393 [ $::locale->text('Invoice Number'), sub { $_[0]->presenter->sales_invoice(display => 'table-cell') } ],
394 [ $::locale->text('Quotation Number'), 'quonumber' ],
395 [ $::locale->text('Order Number'), 'ordnumber' ],
396 [ $::locale->text('Customer'), 'customer' ],
397 [ $::locale->text('Net amount'), 'netamount' ],
398 [ $::locale->text('Paid'), 'paid' ],
399 [ $::locale->text('Transaction description'), 'transaction_description' ],
405 sub _purchase_invoice_list {
406 my ($list, %params) = @_;
410 title => $::locale->text('Purchase Invoices'),
411 type => 'purchase_invoice',
413 [ $::locale->text('Invoice Date'), 'transdate' ],
414 [ $::locale->text('Invoice Number'), sub { $_[0]->presenter->purchase_invoice(display => 'table-cell') } ],
415 [ $::locale->text('Request for Quotation Number'), 'quonumber' ],
416 [ $::locale->text('Order Number'), 'ordnumber' ],
417 [ $::locale->text('Vendor'), 'vendor' ],
418 [ $::locale->text('Net amount'), 'netamount' ],
419 [ $::locale->text('Paid'), 'paid' ],
420 [ $::locale->text('Transaction description'), 'transaction_description' ],
426 sub _ar_transaction_list {
427 my ($list, %params) = @_;
431 title => $::locale->text('AR Transactions'),
432 type => 'ar_transaction',
434 [ $::locale->text('Invoice Date'), 'transdate' ],
435 [ $::locale->text('Type'), sub { $_[0]->displayable_type } ],
436 [ $::locale->text('Invoice Number'), sub { $_[0]->presenter->ar_transaction(display => 'table-cell') } ],
437 [ $::locale->text('Customer'), 'customer' ],
438 [ $::locale->text('Net amount'), 'netamount' ],
439 [ $::locale->text('Paid'), 'paid' ],
440 [ $::locale->text('Transaction description'), 'transaction_description' ],
446 sub _ap_transaction_list {
447 my ($list, %params) = @_;
451 title => $::locale->text('AP Transactions'),
452 type => 'ap_transaction',
454 [ $::locale->text('Invoice Date'), 'transdate' ],
455 [ $::locale->text('Invoice Number'), sub { $_[0]->presenter->ap_transaction(display => 'table-cell') } ],
456 [ $::locale->text('Vendor'), 'vendor' ],
457 [ $::locale->text('Net amount'), 'netamount' ],
458 [ $::locale->text('Paid'), 'paid' ],
459 [ $::locale->text('Transaction description'), 'transaction_description' ],
465 sub _gl_transaction_list {
466 my ($list, %params) = @_;
470 title => $::locale->text('GL Transactions'),
471 type => 'gl_transaction',
473 [ $::locale->text('Transdate'), 'transdate' ],
474 [ $::locale->text('Reference'), 'reference' ],
475 [ $::locale->text('Description'), sub { $_[0]->presenter->gl_transaction(display => 'table-cell') } ],
481 sub _bank_transactions {
482 my ($list, %params) = @_;
486 title => $::locale->text('Bank transactions'),
487 type => 'bank_transactions',
489 [ $::locale->text('Transdate'), 'transdate' ],
490 [ $::locale->text('Local Bank Code'), sub { $_[0]->local_bank_account->presenter->bank_code } ],
491 [ $::locale->text('Local account number'), sub { $_[0]->local_bank_account->presenter->account_number } ],
492 [ $::locale->text('Remote Bank Code'), 'remote_bank_code' ],
493 [ $::locale->text('Remote account number'),'remote_account_number' ],
494 [ $::locale->text('Valutadate'), 'valutadate' ],
495 [ $::locale->text('Amount'), 'amount' ],
496 [ $::locale->text('Currency'), sub { $_[0]->currency->name } ],
497 [ $::locale->text('Remote name'), 'remote_name' ],
498 [ $::locale->text('Purpose'), 'purpose' ],
504 sub _sepa_export_list {
505 my ($list, %params) = @_;
507 my ($source, $destination) = $params{type} eq 'sepa_transfer' ? qw(our vc) : qw(vc our);
508 $params{title} = $params{type} eq 'sepa_transfer' ? $::locale->text('Bank transfers via SEPA') : $::locale->text('Bank collections via SEPA');
509 $params{with_columns} = [ grep { $_ ne 'record_link_direction' } @{ $params{with_columns} || [] } ];
511 delete $params{edit_record_links};
516 [ $::locale->text('Export Number'), 'sepa_export', ],
517 [ $::locale->text('Execution date'), 'execution_date' ],
518 [ $::locale->text('Export date'), sub { $_[0]->sepa_export->itime->to_kivitendo } ],
519 [ $::locale->text('Source BIC'), "${source}_bic" ],
520 [ $::locale->text('Source IBAN'), "${source}_iban" ],
521 [ $::locale->text('Destination BIC'), "${destination}_bic" ],
522 [ $::locale->text('Destination IBAN'), "${destination}_iban" ],
523 [ $::locale->text('Amount'), 'amount' ],
529 sub _sepa_transfer_list {
530 my ($list, %params) = @_;
531 _sepa_export_list($list, %params, type => 'sepa_transfer');
534 sub _sepa_collection_list {
535 my ($list, %params) = @_;
536 _sepa_export_list($list, %params, type => 'sepa_collection');
540 my ($list, %params) = @_;
544 title => $::locale->text('Letters'),
547 [ $::locale->text('Date'), 'date' ],
548 [ $::locale->text('Letternumber'), sub { $_[0]->presenter->letter(display => 'table-cell') } ],
549 [ $::locale->text('Customer'), 'customer' ],
550 [ $::locale->text('Reference'), 'reference' ],
551 [ $::locale->text('Subject'), 'subject' ],
567 SL::Presenter::Record - Presenter module for lists of
568 sales/purchase/general ledger record Rose::DB objects
572 # Retrieve a number of documents from somewhere, e.g.
573 my $order = SL::DB::Manager::Order->get_first(where => [ SL::DB::Manager::Order->type_filter('sales_order') ]);
574 my $records = $order->linked_records(destination => 'to');
576 # Give HTML representation:
577 my $html = SL::Presenter->get->grouped_record_list($records);
589 Returns a rendered version (actually an instance of
590 L<SL::Presenter::EscapedText>) of a single ar, ap or gl object.
593 # fetch the record from a random acc_trans object and print its link (could be ar, ap or gl)
594 my $record = SL::DB::Manager::AccTransaction->get_first()->record;
595 my $html = SL::Presenter->get->record($record, display => 'inline');
597 =item C<grouped_record_list $list, %params>
599 =item C<empty_record_list>
601 Returns a rendered version (actually an instance of
602 L<SL::Presenter::EscapedText>) of an empty list of records. Is usually
603 only called by L<grouped_record_list> if its list is empty.
605 =item C<grouped_record_list $list, %params>
607 Given a number of Rose::DB objects in the array reference C<$list>
608 this function first groups them by type. Then it calls L<record_list>
609 with each non-empty type-specific sub-list and the appropriate
610 parameters for outputting a list of those records.
612 Returns a rendered version (actually an instance of
613 L<SL::Presenter::EscapedText>) of all the lists.
615 The order in which the records are grouped is:
619 =item * sales quotations
623 =item * sales delivery orders
625 =item * sales invoices
627 =item * AR transactions
629 =item * requests for quotations
631 =item * purchase orders
633 =item * purchase delivery orders
635 =item * purchase invoices
637 =item * AP transactions
639 =item * GL transactions
641 =item * SEPA collections
643 =item * SEPA transfers
647 Objects of unknown types are skipped.
649 Parameters are passed to C<record_list> include C<with_objects> and
650 C<edit_record_links>.
652 =item C<record_list $list, %params>
654 Returns a rendered version (actually an instance of
655 L<SL::Presenter::EscapedText>) of a list of records. This list
656 consists of a heading and a tabular representation of the list.
658 The parameters include:
664 Mandatory. The title to use in the heading. Must already be
669 Mandatory. An array reference of column specs to output. Each column
670 spec can be either an array reference or a hash reference.
672 If a column spec is an array reference then the first element is the
673 column's name shown in the table header. It must already be translated.
675 The second element can be either a string or a code reference. A
676 string is taken as the name of a function to call on the Rose::DB
677 object for the current row. Its return value is formatted depending on
678 the column's type (e.g. dates are output as the user expects them,
679 floating point numbers are rounded to two decimal places and
680 right-aligned etc). If it is a code reference then that code is called
681 with the object as the first argument. Its return value should be an
682 instance of L<SL::Presenter::EscapedText> and contain the rendered
683 representation of the content to output.
685 The third element, if present, can be a link to which the column will
688 If the column spec is a hash reference then the same arguments are
689 expected. The corresponding hash keys are C<title>, C<data> and
692 =item C<with_columns>
694 Can be set by the caller to indicate additional columns to
695 be listed. Currently supported:
699 =item C<record_link_destination>
701 The record link destination. Requires that the records to be listed have
702 been retrieved via the L<SL::DB::Helper::LinkedRecords> helper.
706 =item C<edit_record_links>
708 If trueish additional controls will be rendered that allow the user to
709 remove and add record links. Requires that the records to be listed have
710 been retrieved via the L<SL::DB::Helper::LinkedRecords> helper.
722 Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>