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};
68 $output .= _email_journal_list( $groups{email_journals}, %params) if $groups{email_journals};
70 $output = SL::Presenter->get->render('presenter/record/grouped_record_list', %params, output => $output);
75 sub grouped_list { goto &grouped_record_list }
77 sub empty_record_list {
79 return grouped_record_list([], %params);
82 sub empty_list { goto &empty_record_list }
85 my ($list, %params) = @_;
89 if (ref($params{columns}) eq 'ARRAY') {
91 if (ref($_) eq 'ARRAY') {
92 { title => $_->[0], data => $_->[1], link => $_->[2] }
96 } @{ delete $params{columns} };
99 croak "Wrong type for 'columns' argument: not an array reference";
102 my %with_columns = map { ($_ => 1) } @{ _arrayify($params{with_columns}) };
103 if ($with_columns{record_link_direction}) {
105 title => $::locale->text('Link direction'),
107 $_[0]->{_record_link_depth} > 1
108 ? $::locale->text('Row was linked to another record')
109 : $_[0]->{_record_link_direction} eq 'from'
110 ? $::locale->text('Row was source for current record')
111 : $::locale->text('Row was created from current record') },
115 my %column_meta = map { $_->name => $_ } @{ $list->[0]->meta->columns };
116 my %relationships = map { $_->name => $_ } @{ $list->[0]->meta->relationships };
119 my ($obj, $method, @args) = @_;
120 $obj->$method(@args);
124 foreach my $obj (@{ $list }) {
127 foreach my $spec (@columns) {
130 my $method = $spec->{column} || $spec->{data};
131 my $meta = $column_meta{ $spec->{data} };
132 my $type = ref $meta;
133 my $relationship = $relationships{ $spec->{data} };
134 my $rel_type = !$relationship ? '' : $relationship->class;
135 $rel_type =~ s/^SL::DB:://;
136 $rel_type = SL::Util::snakify($rel_type);
138 if (ref($spec->{data}) eq 'CODE') {
139 $cell{value} = $spec->{data}->($obj);
142 $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')
143 : $type eq 'Rose::DB::Object::Metadata::Column::Date' ? $call->($obj, $method . '_as_date')
144 : $type =~ m/^Rose::DB::Object::Metadata::Column::(?:Float|Numeric|Real)$/ ? $::form->format_amount(\%::myconfig, $call->($obj, $method), 2)
145 : $type eq 'Rose::DB::Object::Metadata::Column::Boolean' ? $call->($obj, $method . '_as_bool_yn')
146 : $type =~ m/^Rose::DB::Object::Metadata::Column::(?:Integer|Serial)$/ ? $spec->{data} * 1
147 : $call->($obj, $method);
150 $cell{alignment} = 'right' if $type =~ m/int|serial|float|real|numeric/;
155 push @data, { columns => \@row, record_link => $obj->{_record_link} };
159 map +{ value => $columns[$_]->{title},
160 alignment => $data[0]->{columns}->[$_]->{alignment},
161 }, (0..scalar(@columns) - 1);
163 return SL::Presenter->get->render(
164 'presenter/record/record_list',
166 TABLE_HEADER => \@header,
167 TABLE_ROWS => \@data,
171 sub list { goto &record_list }
180 requirement_specs => sub { (ref($_[0]) eq 'SL::DB::RequirementSpec') },
181 shop_orders => sub { (ref($_[0]) eq 'SL::DB::ShopOrder') && $_[0]->id },
182 sales_quotations => sub { (ref($_[0]) eq 'SL::DB::Order') && $_[0]->is_type('sales_quotation') },
183 sales_orders => sub { (ref($_[0]) eq 'SL::DB::Order') && $_[0]->is_type('sales_order') },
184 sales_delivery_orders => sub { (ref($_[0]) eq 'SL::DB::DeliveryOrder') && $_[0]->is_sales },
185 sales_invoices => sub { (ref($_[0]) eq 'SL::DB::Invoice') && $_[0]->invoice },
186 ar_transactions => sub { (ref($_[0]) eq 'SL::DB::Invoice') && !$_[0]->invoice },
187 purchase_quotations => sub { (ref($_[0]) eq 'SL::DB::Order') && $_[0]->is_type('request_quotation') },
188 purchase_orders => sub { (ref($_[0]) eq 'SL::DB::Order') && $_[0]->is_type('purchase_order') },
189 purchase_delivery_orders => sub { (ref($_[0]) eq 'SL::DB::DeliveryOrder') && !$_[0]->is_sales },
190 purchase_invoices => sub { (ref($_[0]) eq 'SL::DB::PurchaseInvoice') && $_[0]->invoice },
191 ap_transactions => sub { (ref($_[0]) eq 'SL::DB::PurchaseInvoice') && !$_[0]->invoice },
192 sepa_collections => sub { (ref($_[0]) eq 'SL::DB::SepaExportItem') && $_[0]->ar_id },
193 sepa_transfers => sub { (ref($_[0]) eq 'SL::DB::SepaExportItem') && $_[0]->ap_id },
194 gl_transactions => sub { (ref($_[0]) eq 'SL::DB::GLTransaction') },
195 bank_transactions => sub { (ref($_[0]) eq 'SL::DB::BankTransaction') && $_[0]->id },
196 letters => sub { (ref($_[0]) eq 'SL::DB::Letter') && $_[0]->id },
197 email_journals => sub { (ref($_[0]) eq 'SL::DB::EmailJournal') && $_[0]->id },
202 foreach my $record (@{ $list || [] }) {
203 my $type = (first { $matchers{$_}->($record) } keys %matchers) || 'other';
204 $groups{$type} ||= [];
205 push @{ $groups{$type} }, $record;
211 sub _sort_grouped_lists {
214 foreach my $group (keys %groups) {
215 next unless @{ $groups{$group} };
216 if ($groups{$group}->[0]->can('compare_to')) {
217 $groups{$group} = [ sort { $a->compare_to($b) } @{ $groups{$group} } ];
219 $groups{$group} = [ sort { $a->date <=> $b->date } @{ $groups{$group} } ];
226 sub _requirement_spec_list {
227 my ($list, %params) = @_;
231 title => $::locale->text('Requirement specs'),
232 type => 'requirement_spec',
234 [ $::locale->text('Requirement spec number'), sub { $_[0]->presenter->requirement_spec(display => 'table-cell') } ],
235 [ $::locale->text('Customer'), 'customer' ],
236 [ $::locale->text('Title'), 'title' ],
237 [ $::locale->text('Project'), 'project', ],
238 [ $::locale->text('Status'), sub { $_[0]->status->description } ],
244 sub _shop_order_list {
245 my ($list, %params) = @_;
249 title => $::locale->text('Shop Orders'),
250 type => 'shop_order',
252 [ $::locale->text('Shop Order Date'), sub { $_[0]->order_date->to_kivitendo } ],
253 [ $::locale->text('Shop Order Number'), sub { $_[0]->presenter->shop_order(display => 'table-cell') } ],
254 [ $::locale->text('Transfer Date'), 'transfer_date' ],
255 [ $::locale->text('Amount'), 'amount' ],
261 sub _sales_quotation_list {
262 my ($list, %params) = @_;
266 title => $::locale->text('Sales Quotations'),
267 type => 'sales_quotation',
269 [ $::locale->text('Quotation Date'), 'transdate' ],
270 [ $::locale->text('Quotation Number'), sub { $_[0]->presenter->sales_quotation(display => 'table-cell') } ],
271 [ $::locale->text('Customer'), 'customer' ],
272 [ $::locale->text('Net amount'), 'netamount' ],
273 [ $::locale->text('Transaction description'), 'transaction_description' ],
274 [ $::locale->text('Project'), 'globalproject', ],
275 [ $::locale->text('Closed'), 'closed' ],
281 sub _request_quotation_list {
282 my ($list, %params) = @_;
286 title => $::locale->text('Request Quotations'),
287 type => 'request_quotation',
289 [ $::locale->text('Quotation Date'), 'transdate' ],
290 [ $::locale->text('Quotation Number'), sub { $_[0]->presenter->request_quotation(display => 'table-cell') } ],
291 [ $::locale->text('Vendor'), 'vendor' ],
292 [ $::locale->text('Net amount'), 'netamount' ],
293 [ $::locale->text('Transaction description'), 'transaction_description' ],
294 [ $::locale->text('Project'), 'globalproject', ],
295 [ $::locale->text('Closed'), 'closed' ],
301 sub _sales_order_list {
302 my ($list, %params) = @_;
306 title => $::locale->text('Sales Orders'),
307 type => 'sales_order',
309 [ $::locale->text('Order Date'), 'transdate' ],
310 [ $::locale->text('Order Number'), sub { $_[0]->presenter->sales_order(display => 'table-cell') } ],
311 [ $::locale->text('Quotation'), 'quonumber' ],
312 [ $::locale->text('Customer'), 'customer' ],
313 [ $::locale->text('Net amount'), 'netamount' ],
314 [ $::locale->text('Transaction description'), 'transaction_description' ],
315 [ $::locale->text('Project'), 'globalproject', ],
316 [ $::locale->text('Closed'), 'closed' ],
322 sub _purchase_order_list {
323 my ($list, %params) = @_;
327 title => $::locale->text('Purchase Orders'),
328 type => 'purchase_order',
330 [ $::locale->text('Order Date'), 'transdate' ],
331 [ $::locale->text('Order Number'), sub { $_[0]->presenter->purchase_order(display => 'table-cell') } ],
332 [ $::locale->text('Request for Quotation'), 'quonumber' ],
333 [ $::locale->text('Vendor'), 'vendor' ],
334 [ $::locale->text('Net amount'), 'netamount' ],
335 [ $::locale->text('Transaction description'), 'transaction_description' ],
336 [ $::locale->text('Project'), 'globalproject', ],
337 [ $::locale->text('Closed'), 'closed' ],
343 sub _sales_delivery_order_list {
344 my ($list, %params) = @_;
348 title => $::locale->text('Sales Delivery Orders'),
349 type => 'sales_delivery_order',
351 [ $::locale->text('Delivery Order Date'), 'transdate' ],
352 [ $::locale->text('Delivery Order Number'), sub { $_[0]->presenter->sales_delivery_order(display => 'table-cell') } ],
353 [ $::locale->text('Order Number'), 'ordnumber' ],
354 [ $::locale->text('Customer'), 'customer' ],
355 [ $::locale->text('Transaction description'), 'transaction_description' ],
356 [ $::locale->text('Project'), 'globalproject', ],
357 [ $::locale->text('Delivered'), 'delivered' ],
358 [ $::locale->text('Closed'), 'closed' ],
364 sub _purchase_delivery_order_list {
365 my ($list, %params) = @_;
369 title => $::locale->text('Purchase Delivery Orders'),
370 type => 'purchase_delivery_order',
372 [ $::locale->text('Delivery Order Date'), 'transdate' ],
373 [ $::locale->text('Delivery Order Number'), sub { $_[0]->presenter->purchase_delivery_order(display => 'table-cell') } ],
374 [ $::locale->text('Order Number'), 'ordnumber' ],
375 [ $::locale->text('Vendor'), 'vendor' ],
376 [ $::locale->text('Transaction description'), 'transaction_description' ],
377 [ $::locale->text('Project'), 'globalproject', ],
378 [ $::locale->text('Delivered'), 'delivered' ],
379 [ $::locale->text('Closed'), 'closed' ],
385 sub _sales_invoice_list {
386 my ($list, %params) = @_;
390 title => $::locale->text('Sales Invoices'),
391 type => 'sales_invoice',
393 [ $::locale->text('Invoice Date'), 'transdate' ],
394 [ $::locale->text('Type'), sub { $_[0]->displayable_type } ],
395 [ $::locale->text('Invoice Number'), sub { $_[0]->presenter->sales_invoice(display => 'table-cell') } ],
396 [ $::locale->text('Quotation Number'), 'quonumber' ],
397 [ $::locale->text('Order Number'), 'ordnumber' ],
398 [ $::locale->text('Customer'), 'customer' ],
399 [ $::locale->text('Net amount'), 'netamount' ],
400 [ $::locale->text('Paid'), 'paid' ],
401 [ $::locale->text('Transaction description'), 'transaction_description' ],
407 sub _purchase_invoice_list {
408 my ($list, %params) = @_;
412 title => $::locale->text('Purchase Invoices'),
413 type => 'purchase_invoice',
415 [ $::locale->text('Invoice Date'), 'transdate' ],
416 [ $::locale->text('Invoice Number'), sub { $_[0]->presenter->purchase_invoice(display => 'table-cell') } ],
417 [ $::locale->text('Request for Quotation Number'), 'quonumber' ],
418 [ $::locale->text('Order Number'), 'ordnumber' ],
419 [ $::locale->text('Vendor'), 'vendor' ],
420 [ $::locale->text('Net amount'), 'netamount' ],
421 [ $::locale->text('Paid'), 'paid' ],
422 [ $::locale->text('Transaction description'), 'transaction_description' ],
428 sub _ar_transaction_list {
429 my ($list, %params) = @_;
433 title => $::locale->text('AR Transactions'),
434 type => 'ar_transaction',
436 [ $::locale->text('Invoice Date'), 'transdate' ],
437 [ $::locale->text('Type'), sub { $_[0]->displayable_type } ],
438 [ $::locale->text('Invoice Number'), sub { $_[0]->presenter->ar_transaction(display => 'table-cell') } ],
439 [ $::locale->text('Customer'), 'customer' ],
440 [ $::locale->text('Net amount'), 'netamount' ],
441 [ $::locale->text('Paid'), 'paid' ],
442 [ $::locale->text('Transaction description'), 'transaction_description' ],
448 sub _ap_transaction_list {
449 my ($list, %params) = @_;
453 title => $::locale->text('AP Transactions'),
454 type => 'ap_transaction',
456 [ $::locale->text('Invoice Date'), 'transdate' ],
457 [ $::locale->text('Invoice Number'), sub { $_[0]->presenter->ap_transaction(display => 'table-cell') } ],
458 [ $::locale->text('Vendor'), 'vendor' ],
459 [ $::locale->text('Net amount'), 'netamount' ],
460 [ $::locale->text('Paid'), 'paid' ],
461 [ $::locale->text('Transaction description'), 'transaction_description' ],
467 sub _gl_transaction_list {
468 my ($list, %params) = @_;
472 title => $::locale->text('GL Transactions'),
473 type => 'gl_transaction',
475 [ $::locale->text('Transdate'), 'transdate' ],
476 [ $::locale->text('Reference'), 'reference' ],
477 [ $::locale->text('Description'), sub { $_[0]->presenter->gl_transaction(display => 'table-cell') } ],
483 sub _bank_transactions {
484 my ($list, %params) = @_;
488 title => $::locale->text('Bank transactions'),
489 type => 'bank_transactions',
491 [ $::locale->text('Transdate'), 'transdate' ],
492 [ $::locale->text('Local Bank Code'), sub { $_[0]->local_bank_account->presenter->bank_code } ],
493 [ $::locale->text('Local account number'), sub { $_[0]->local_bank_account->presenter->account_number } ],
494 [ $::locale->text('Remote Bank Code'), 'remote_bank_code' ],
495 [ $::locale->text('Remote account number'),'remote_account_number' ],
496 [ $::locale->text('Valutadate'), 'valutadate' ],
497 [ $::locale->text('Amount'), 'amount' ],
498 [ $::locale->text('Currency'), sub { $_[0]->currency->name } ],
499 [ $::locale->text('Remote name'), 'remote_name' ],
500 [ $::locale->text('Purpose'), 'purpose' ],
506 sub _sepa_export_list {
507 my ($list, %params) = @_;
509 my ($source, $destination) = $params{type} eq 'sepa_transfer' ? qw(our vc) : qw(vc our);
510 $params{title} = $params{type} eq 'sepa_transfer' ? $::locale->text('Bank transfers via SEPA') : $::locale->text('Bank collections via SEPA');
511 $params{with_columns} = [ grep { $_ ne 'record_link_direction' } @{ $params{with_columns} || [] } ];
513 delete $params{edit_record_links};
518 [ $::locale->text('Export Number'), 'sepa_export', ],
519 [ $::locale->text('Execution date'), 'execution_date' ],
520 [ $::locale->text('Export date'), sub { $_[0]->sepa_export->itime->to_kivitendo } ],
521 [ $::locale->text('Source BIC'), "${source}_bic" ],
522 [ $::locale->text('Source IBAN'), "${source}_iban" ],
523 [ $::locale->text('Destination BIC'), "${destination}_bic" ],
524 [ $::locale->text('Destination IBAN'), "${destination}_iban" ],
525 [ $::locale->text('Amount'), 'amount' ],
531 sub _sepa_transfer_list {
532 my ($list, %params) = @_;
533 _sepa_export_list($list, %params, type => 'sepa_transfer');
536 sub _sepa_collection_list {
537 my ($list, %params) = @_;
538 _sepa_export_list($list, %params, type => 'sepa_collection');
542 my ($list, %params) = @_;
546 title => $::locale->text('Letters'),
549 [ $::locale->text('Date'), 'date' ],
550 [ $::locale->text('Letternumber'), sub { $_[0]->presenter->letter(display => 'table-cell') } ],
551 [ $::locale->text('Customer'), 'customer' ],
552 [ $::locale->text('Reference'), 'reference' ],
553 [ $::locale->text('Subject'), 'subject' ],
559 sub _email_journal_list {
560 my ($list, %params) = @_;
564 title => $::locale->text('Email'),
565 type => 'email_journal',
567 [ $::locale->text('Sent on'), sub { $_[0]->sent_on->to_kivitendo(precision => 'seconds') } ],
568 [ $::locale->text('Subject'), sub { $_[0]->presenter->email_journal(display => 'table-cell') } ],
569 [ $::locale->text('Status'), 'status' ],
570 [ $::locale->text('From'), 'from' ],
571 [ $::locale->text('To'), 'recipients' ],
588 SL::Presenter::Record - Presenter module for lists of
589 sales/purchase/general ledger record Rose::DB objects
593 # Retrieve a number of documents from somewhere, e.g.
594 my $order = SL::DB::Manager::Order->get_first(where => [ SL::DB::Manager::Order->type_filter('sales_order') ]);
595 my $records = $order->linked_records(destination => 'to');
597 # Give HTML representation:
598 my $html = SL::Presenter->get->grouped_record_list($records);
610 Returns a rendered version (actually an instance of
611 L<SL::Presenter::EscapedText>) of a single ar, ap or gl object.
614 # fetch the record from a random acc_trans object and print its link (could be ar, ap or gl)
615 my $record = SL::DB::Manager::AccTransaction->get_first()->record;
616 my $html = SL::Presenter->get->record($record, display => 'inline');
618 =item C<grouped_record_list $list, %params>
620 =item C<empty_record_list>
622 Returns a rendered version (actually an instance of
623 L<SL::Presenter::EscapedText>) of an empty list of records. Is usually
624 only called by L<grouped_record_list> if its list is empty.
626 =item C<grouped_record_list $list, %params>
628 Given a number of Rose::DB objects in the array reference C<$list>
629 this function first groups them by type. Then it calls L<record_list>
630 with each non-empty type-specific sub-list and the appropriate
631 parameters for outputting a list of those records.
633 Returns a rendered version (actually an instance of
634 L<SL::Presenter::EscapedText>) of all the lists.
636 The order in which the records are grouped is:
640 =item * sales quotations
644 =item * sales delivery orders
646 =item * sales invoices
648 =item * AR transactions
650 =item * requests for quotations
652 =item * purchase orders
654 =item * purchase delivery orders
656 =item * purchase invoices
658 =item * AP transactions
660 =item * GL transactions
662 =item * SEPA collections
664 =item * SEPA transfers
668 Objects of unknown types are skipped.
670 Parameters are passed to C<record_list> include C<with_objects> and
671 C<edit_record_links>.
673 =item C<record_list $list, %params>
675 Returns a rendered version (actually an instance of
676 L<SL::Presenter::EscapedText>) of a list of records. This list
677 consists of a heading and a tabular representation of the list.
679 The parameters include:
685 Mandatory. The title to use in the heading. Must already be
690 Mandatory. An array reference of column specs to output. Each column
691 spec can be either an array reference or a hash reference.
693 If a column spec is an array reference then the first element is the
694 column's name shown in the table header. It must already be translated.
696 The second element can be either a string or a code reference. A
697 string is taken as the name of a function to call on the Rose::DB
698 object for the current row. Its return value is formatted depending on
699 the column's type (e.g. dates are output as the user expects them,
700 floating point numbers are rounded to two decimal places and
701 right-aligned etc). If it is a code reference then that code is called
702 with the object as the first argument. Its return value should be an
703 instance of L<SL::Presenter::EscapedText> and contain the rendered
704 representation of the content to output.
706 The third element, if present, can be a link to which the column will
709 If the column spec is a hash reference then the same arguments are
710 expected. The corresponding hash keys are C<title>, C<data> and
713 =item C<with_columns>
715 Can be set by the caller to indicate additional columns to
716 be listed. Currently supported:
720 =item C<record_link_destination>
722 The record link destination. Requires that the records to be listed have
723 been retrieved via the L<SL::DB::Helper::LinkedRecords> helper.
727 =item C<edit_record_links>
729 If trueish additional controls will be rendered that allow the user to
730 remove and add record links. Requires that the records to be listed have
731 been retrieved via the L<SL::DB::Helper::LinkedRecords> helper.
743 Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>