1 package SL::Presenter::Record;
5 use parent qw(Exporter);
7 use Exporter qw(import);
8 our @EXPORT = qw(grouped_record_list empty_record_list record_list record);
13 use List::Util qw(first);
17 return [] if !defined $array;
18 return $array if ref $array;
23 my ($self, $record, %params) = @_;
25 my %grouped = _group_records( [ $record ] ); # pass $record as arrayref
26 my $type = (keys %grouped)[0];
28 return $self->sales_invoice( $record, %params) if $type eq 'sales_invoices';
29 return $self->purchase_invoice($record, %params) if $type eq 'purchase_invoices';
30 return $self->ar_transaction( $record, %params) if $type eq 'ar_transactions';
31 return $self->ap_transaction( $record, %params) if $type eq 'ap_transactions';
32 return $self->gl_transaction( $record, %params) if $type eq 'gl_transactions';
37 sub grouped_record_list {
38 my ($self, $list, %params) = @_;
40 %params = map { exists $params{$_} ? ($_ => $params{$_}) : () } qw(edit_record_links with_columns object_id object_model);
42 my %groups = _sort_grouped_lists(_group_records($list));
45 $output .= _requirement_spec_list( $self, $groups{requirement_specs}, %params) if $groups{requirement_specs};
46 $output .= _sales_quotation_list( $self, $groups{sales_quotations}, %params) if $groups{sales_quotations};
47 $output .= _sales_order_list( $self, $groups{sales_orders}, %params) if $groups{sales_orders};
48 $output .= _sales_delivery_order_list( $self, $groups{sales_delivery_orders}, %params) if $groups{sales_delivery_orders};
49 $output .= _sales_invoice_list( $self, $groups{sales_invoices}, %params) if $groups{sales_invoices};
50 $output .= _ar_transaction_list( $self, $groups{ar_transactions}, %params) if $groups{ar_transactions};
52 $output .= _request_quotation_list( $self, $groups{purchase_quotations}, %params) if $groups{purchase_quotations};
53 $output .= _purchase_order_list( $self, $groups{purchase_orders}, %params) if $groups{purchase_orders};
54 $output .= _purchase_delivery_order_list($self, $groups{purchase_delivery_orders}, %params) if $groups{purchase_delivery_orders};
55 $output .= _purchase_invoice_list( $self, $groups{purchase_invoices}, %params) if $groups{purchase_invoices};
56 $output .= _ap_transaction_list( $self, $groups{ap_transactions}, %params) if $groups{ap_transactions};
58 $output .= _gl_transaction_list( $self, $groups{gl_transactions}, %params) if $groups{gl_transactions};
60 $output .= _bank_transactions( $self, $groups{bank_transactions}, %params) if $groups{bank_transactions};
62 $output .= _sepa_collection_list( $self, $groups{sepa_collections}, %params) if $groups{sepa_collections};
63 $output .= _sepa_transfer_list( $self, $groups{sepa_transfers}, %params) if $groups{sepa_transfers};
65 $output .= _letter_list( $self, $groups{letters}, %params) if $groups{letters};
67 $output = $self->render('presenter/record/grouped_record_list', %params, output => $output);
72 sub empty_record_list {
73 my ($self, %params) = @_;
74 return $self->grouped_record_list([], %params);
78 my ($self, $list, %params) = @_;
82 if (ref($params{columns}) eq 'ARRAY') {
84 if (ref($_) eq 'ARRAY') {
85 { title => $_->[0], data => $_->[1], link => $_->[2] }
89 } @{ delete $params{columns} };
92 croak "Wrong type for 'columns' argument: not an array reference";
95 my %with_columns = map { ($_ => 1) } @{ _arrayify($params{with_columns}) };
96 if ($with_columns{record_link_direction}) {
98 title => $::locale->text('Link direction'),
100 $_[0]->{_record_link_depth} > 1
101 ? $::locale->text('Row was linked to another record')
102 : $_[0]->{_record_link_direction} eq 'from'
103 ? $::locale->text('Row was source for current record')
104 : $::locale->text('Row was created from current record') },
108 my %column_meta = map { $_->name => $_ } @{ $list->[0]->meta->columns };
109 my %relationships = map { $_->name => $_ } @{ $list->[0]->meta->relationships };
112 my ($obj, $method, @args) = @_;
113 $obj->$method(@args);
117 foreach my $obj (@{ $list }) {
120 foreach my $spec (@columns) {
123 my $method = $spec->{column} || $spec->{data};
124 my $meta = $column_meta{ $spec->{data} };
125 my $type = ref $meta;
126 my $relationship = $relationships{ $spec->{data} };
127 my $rel_type = !$relationship ? '' : $relationship->class;
128 $rel_type =~ s/^SL::DB:://;
129 $rel_type = SL::Util::snakify($rel_type);
131 if (ref($spec->{data}) eq 'CODE') {
132 $cell{value} = $spec->{data}->($obj);
135 $cell{value} = $rel_type && $self->can($rel_type) ? $self->$rel_type($obj->$method, display => 'table-cell')
136 : $type eq 'Rose::DB::Object::Metadata::Column::Date' ? $call->($obj, $method . '_as_date')
137 : $type =~ m/^Rose::DB::Object::Metadata::Column::(?:Float|Numeric|Real)$/ ? $::form->format_amount(\%::myconfig, $call->($obj, $method), 2)
138 : $type eq 'Rose::DB::Object::Metadata::Column::Boolean' ? $call->($obj, $method . '_as_bool_yn')
139 : $type =~ m/^Rose::DB::Object::Metadata::Column::(?:Integer|Serial)$/ ? $spec->{data} * 1
140 : $call->($obj, $method);
143 $cell{alignment} = 'right' if $type =~ m/int|serial|float|real|numeric/;
148 push @data, { columns => \@row, record_link => $obj->{_record_link} };
152 map +{ value => $columns[$_]->{title},
153 alignment => $data[0]->{columns}->[$_]->{alignment},
154 }, (0..scalar(@columns) - 1);
156 return $self->render(
157 'presenter/record/record_list',
159 TABLE_HEADER => \@header,
160 TABLE_ROWS => \@data,
172 requirement_specs => sub { (ref($_[0]) eq 'SL::DB::RequirementSpec') },
173 sales_quotations => sub { (ref($_[0]) eq 'SL::DB::Order') && $_[0]->is_type('sales_quotation') },
174 sales_orders => sub { (ref($_[0]) eq 'SL::DB::Order') && $_[0]->is_type('sales_order') },
175 sales_delivery_orders => sub { (ref($_[0]) eq 'SL::DB::DeliveryOrder') && $_[0]->is_sales },
176 sales_invoices => sub { (ref($_[0]) eq 'SL::DB::Invoice') && $_[0]->invoice },
177 ar_transactions => sub { (ref($_[0]) eq 'SL::DB::Invoice') && !$_[0]->invoice },
178 purchase_quotations => sub { (ref($_[0]) eq 'SL::DB::Order') && $_[0]->is_type('request_quotation') },
179 purchase_orders => sub { (ref($_[0]) eq 'SL::DB::Order') && $_[0]->is_type('purchase_order') },
180 purchase_delivery_orders => sub { (ref($_[0]) eq 'SL::DB::DeliveryOrder') && !$_[0]->is_sales },
181 purchase_invoices => sub { (ref($_[0]) eq 'SL::DB::PurchaseInvoice') && $_[0]->invoice },
182 ap_transactions => sub { (ref($_[0]) eq 'SL::DB::PurchaseInvoice') && !$_[0]->invoice },
183 sepa_collections => sub { (ref($_[0]) eq 'SL::DB::SepaExportItem') && $_[0]->ar_id },
184 sepa_transfers => sub { (ref($_[0]) eq 'SL::DB::SepaExportItem') && $_[0]->ap_id },
185 gl_transactions => sub { (ref($_[0]) eq 'SL::DB::GLTransaction') },
186 bank_transactions => sub { (ref($_[0]) eq 'SL::DB::BankTransaction') && $_[0]->id },
187 letters => sub { (ref($_[0]) eq 'SL::DB::Letter') && $_[0]->id },
192 foreach my $record (@{ $list || [] }) {
193 my $type = (first { $matchers{$_}->($record) } keys %matchers) || 'other';
194 $groups{$type} ||= [];
195 push @{ $groups{$type} }, $record;
201 sub _sort_grouped_lists {
204 foreach my $group (keys %groups) {
205 next unless @{ $groups{$group} };
206 if ($groups{$group}->[0]->can('compare_to')) {
207 $groups{$group} = [ sort { $a->compare_to($b) } @{ $groups{$group} } ];
209 $groups{$group} = [ sort { $a->date <=> $b->date } @{ $groups{$group} } ];
216 sub _requirement_spec_list {
217 my ($self, $list, %params) = @_;
219 return $self->record_list(
221 title => $::locale->text('Requirement specs'),
222 type => 'requirement_spec',
224 [ $::locale->text('Requirement spec number'), sub { $self->requirement_spec($_[0], display => 'table-cell') } ],
225 [ $::locale->text('Customer'), 'customer' ],
226 [ $::locale->text('Title'), 'title' ],
227 [ $::locale->text('Project'), 'project', ],
228 [ $::locale->text('Status'), sub { $_[0]->status->description } ],
234 sub _sales_quotation_list {
235 my ($self, $list, %params) = @_;
237 return $self->record_list(
239 title => $::locale->text('Sales Quotations'),
240 type => 'sales_quotation',
242 [ $::locale->text('Quotation Date'), 'transdate' ],
243 [ $::locale->text('Quotation Number'), sub { $self->sales_quotation($_[0], display => 'table-cell') } ],
244 [ $::locale->text('Customer'), 'customer' ],
245 [ $::locale->text('Net amount'), 'netamount' ],
246 [ $::locale->text('Transaction description'), 'transaction_description' ],
247 [ $::locale->text('Project'), 'globalproject', ],
248 [ $::locale->text('Closed'), 'closed' ],
254 sub _request_quotation_list {
255 my ($self, $list, %params) = @_;
257 return $self->record_list(
259 title => $::locale->text('Request Quotations'),
260 type => 'request_quotation',
262 [ $::locale->text('Quotation Date'), 'transdate' ],
263 [ $::locale->text('Quotation Number'), sub { $self->request_quotation($_[0], display => 'table-cell') } ],
264 [ $::locale->text('Vendor'), 'vendor' ],
265 [ $::locale->text('Net amount'), 'netamount' ],
266 [ $::locale->text('Transaction description'), 'transaction_description' ],
267 [ $::locale->text('Project'), 'globalproject', ],
268 [ $::locale->text('Closed'), 'closed' ],
274 sub _sales_order_list {
275 my ($self, $list, %params) = @_;
277 return $self->record_list(
279 title => $::locale->text('Sales Orders'),
280 type => 'sales_order',
282 [ $::locale->text('Order Date'), 'transdate' ],
283 [ $::locale->text('Order Number'), sub { $self->sales_order($_[0], display => 'table-cell') } ],
284 [ $::locale->text('Quotation'), 'quonumber' ],
285 [ $::locale->text('Customer'), 'customer' ],
286 [ $::locale->text('Net amount'), 'netamount' ],
287 [ $::locale->text('Transaction description'), 'transaction_description' ],
288 [ $::locale->text('Project'), 'globalproject', ],
289 [ $::locale->text('Closed'), 'closed' ],
295 sub _purchase_order_list {
296 my ($self, $list, %params) = @_;
298 return $self->record_list(
300 title => $::locale->text('Purchase Orders'),
301 type => 'purchase_order',
303 [ $::locale->text('Order Date'), 'transdate' ],
304 [ $::locale->text('Order Number'), sub { $self->purchase_order($_[0], display => 'table-cell') } ],
305 [ $::locale->text('Request for Quotation'), 'quonumber' ],
306 [ $::locale->text('Vendor'), 'vendor' ],
307 [ $::locale->text('Net amount'), 'netamount' ],
308 [ $::locale->text('Transaction description'), 'transaction_description' ],
309 [ $::locale->text('Project'), 'globalproject', ],
310 [ $::locale->text('Closed'), 'closed' ],
316 sub _sales_delivery_order_list {
317 my ($self, $list, %params) = @_;
319 return $self->record_list(
321 title => $::locale->text('Sales Delivery Orders'),
322 type => 'sales_delivery_order',
324 [ $::locale->text('Delivery Order Date'), 'transdate' ],
325 [ $::locale->text('Delivery Order Number'), sub { $self->sales_delivery_order($_[0], display => 'table-cell') } ],
326 [ $::locale->text('Order Number'), 'ordnumber' ],
327 [ $::locale->text('Customer'), 'customer' ],
328 [ $::locale->text('Transaction description'), 'transaction_description' ],
329 [ $::locale->text('Project'), 'globalproject', ],
330 [ $::locale->text('Delivered'), 'delivered' ],
331 [ $::locale->text('Closed'), 'closed' ],
337 sub _purchase_delivery_order_list {
338 my ($self, $list, %params) = @_;
340 return $self->record_list(
342 title => $::locale->text('Purchase Delivery Orders'),
343 type => 'purchase_delivery_order',
345 [ $::locale->text('Delivery Order Date'), 'transdate' ],
346 [ $::locale->text('Delivery Order Number'), sub { $self->purchase_delivery_order($_[0], display => 'table-cell') } ],
347 [ $::locale->text('Order Number'), 'ordnumber' ],
348 [ $::locale->text('Vendor'), 'vendor' ],
349 [ $::locale->text('Transaction description'), 'transaction_description' ],
350 [ $::locale->text('Project'), 'globalproject', ],
351 [ $::locale->text('Delivered'), 'delivered' ],
352 [ $::locale->text('Closed'), 'closed' ],
358 sub _sales_invoice_list {
359 my ($self, $list, %params) = @_;
361 return $self->record_list(
363 title => $::locale->text('Sales Invoices'),
364 type => 'sales_invoice',
366 [ $::locale->text('Invoice Date'), 'transdate' ],
367 [ $::locale->text('Type'), sub { $_[0]->displayable_type } ],
368 [ $::locale->text('Invoice Number'), sub { $self->sales_invoice($_[0], display => 'table-cell') } ],
369 [ $::locale->text('Quotation Number'), 'quonumber' ],
370 [ $::locale->text('Order Number'), 'ordnumber' ],
371 [ $::locale->text('Customer'), 'customer' ],
372 [ $::locale->text('Net amount'), 'netamount' ],
373 [ $::locale->text('Paid'), 'paid' ],
374 [ $::locale->text('Transaction description'), 'transaction_description' ],
380 sub _purchase_invoice_list {
381 my ($self, $list, %params) = @_;
383 return $self->record_list(
385 title => $::locale->text('Purchase Invoices'),
386 type => 'purchase_invoice',
388 [ $::locale->text('Invoice Date'), 'transdate' ],
389 [ $::locale->text('Invoice Number'), sub { $self->purchase_invoice($_[0], display => 'table-cell') } ],
390 [ $::locale->text('Request for Quotation Number'), 'quonumber' ],
391 [ $::locale->text('Order Number'), 'ordnumber' ],
392 [ $::locale->text('Vendor'), 'vendor' ],
393 [ $::locale->text('Net amount'), 'netamount' ],
394 [ $::locale->text('Paid'), 'paid' ],
395 [ $::locale->text('Transaction description'), 'transaction_description' ],
401 sub _ar_transaction_list {
402 my ($self, $list, %params) = @_;
404 return $self->record_list(
406 title => $::locale->text('AR Transactions'),
407 type => 'ar_transaction',
409 [ $::locale->text('Invoice Date'), 'transdate' ],
410 [ $::locale->text('Type'), sub { $_[0]->displayable_type } ],
411 [ $::locale->text('Invoice Number'), sub { $self->ar_transaction($_[0], display => 'table-cell') } ],
412 [ $::locale->text('Customer'), 'customer' ],
413 [ $::locale->text('Net amount'), 'netamount' ],
414 [ $::locale->text('Paid'), 'paid' ],
415 [ $::locale->text('Transaction description'), 'transaction_description' ],
421 sub _ap_transaction_list {
422 my ($self, $list, %params) = @_;
424 return $self->record_list(
426 title => $::locale->text('AP Transactions'),
427 type => 'ap_transaction',
429 [ $::locale->text('Invoice Date'), 'transdate' ],
430 [ $::locale->text('Invoice Number'), sub { $self->ap_transaction($_[0 ], display => 'table-cell') } ],
431 [ $::locale->text('Vendor'), 'vendor' ],
432 [ $::locale->text('Net amount'), 'netamount' ],
433 [ $::locale->text('Paid'), 'paid' ],
434 [ $::locale->text('Transaction description'), 'transaction_description' ],
440 sub _gl_transaction_list {
441 my ($self, $list, %params) = @_;
443 return $self->record_list(
445 title => $::locale->text('GL Transactions'),
446 type => 'gl_transaction',
448 [ $::locale->text('Date'), 'transdate' ],
449 [ $::locale->text('Reference'), 'reference' ],
450 [ $::locale->text('Description'), sub { $self->gl_transaction($_[0 ], display => 'table-cell') } ],
456 sub _bank_transactions {
457 my ($self, $list, %params) = @_;
459 return $self->record_list(
461 title => $::locale->text('Bank transactions'),
462 type => 'bank_transactions',
464 [ $::locale->text('Transdate'), 'transdate' ],
465 [ $::locale->text('Local Bank Code'), sub { $self->bank_code($_[0]->local_bank_account) } ],
466 [ $::locale->text('Local account number'), sub { $self->account_number($_[0]->local_bank_account) } ],
467 [ $::locale->text('Remote Bank Code'), 'remote_bank_code' ],
468 [ $::locale->text('Remote account number'),'remote_account_number' ],
469 [ $::locale->text('Valutadate'), 'valutadate' ],
470 [ $::locale->text('Amount'), 'amount' ],
471 [ $::locale->text('Currency'), sub { $_[0]->currency->name } ],
472 [ $::locale->text('Remote name'), 'remote_name' ],
473 [ $::locale->text('Purpose'), 'purpose' ],
479 sub _sepa_export_list {
480 my ($self, $list, %params) = @_;
482 my ($source, $destination) = $params{type} eq 'sepa_transfer' ? qw(our vc) : qw(vc our);
483 $params{title} = $params{type} eq 'sepa_transfer' ? $::locale->text('Bank transfers via SEPA') : $::locale->text('Bank collections via SEPA');
484 $params{with_columns} = [ grep { $_ ne 'record_link_direction' } @{ $params{with_columns} || [] } ];
486 delete $params{edit_record_links};
488 return $self->record_list(
491 [ $::locale->text('Export Number'), 'sepa_export', ],
492 [ $::locale->text('Execution date'), 'execution_date' ],
493 [ $::locale->text('Export date'), sub { $_[0]->sepa_export->itime->to_kivitendo } ],
494 [ $::locale->text('Source BIC'), "${source}_bic" ],
495 [ $::locale->text('Source IBAN'), "${source}_iban" ],
496 [ $::locale->text('Destination BIC'), "${destination}_bic" ],
497 [ $::locale->text('Destination IBAN'), "${destination}_iban" ],
498 [ $::locale->text('Amount'), 'amount' ],
504 sub _sepa_transfer_list {
505 my ($self, $list, %params) = @_;
506 _sepa_export_list($self, $list, %params, type => 'sepa_transfer');
509 sub _sepa_collection_list {
510 my ($self, $list, %params) = @_;
511 _sepa_export_list($self, $list, %params, type => 'sepa_collection');
515 my ($self, $list, %params) = @_;
517 return $self->record_list(
519 title => $::locale->text('Letters'),
522 [ $::locale->text('Date'), 'date' ],
523 [ $::locale->text('Letternumber'), sub { $self->letter($_[0], display => 'table-cell') } ],
524 [ $::locale->text('Customer'), 'customer' ],
525 [ $::locale->text('Reference'), 'reference' ],
526 [ $::locale->text('Subject'), 'subject' ],
542 SL::Presenter::Record - Presenter module for lists of
543 sales/purchase/general ledger record Rose::DB objects
547 # Retrieve a number of documents from somewhere, e.g.
548 my $order = SL::DB::Manager::Order->get_first(where => [ SL::DB::Manager::Order->type_filter('sales_order') ]);
549 my $records = $order->linked_records(destination => 'to');
551 # Give HTML representation:
552 my $html = SL::Presenter->get->grouped_record_list($records);
564 Returns a rendered version (actually an instance of
565 L<SL::Presenter::EscapedText>) of a single ar, ap or gl object.
568 # fetch the record from a random acc_trans object and print its link (could be ar, ap or gl)
569 my $record = SL::DB::Manager::AccTransaction->get_first()->record;
570 my $html = SL::Presenter->get->record($record, display => 'inline');
572 =item C<grouped_record_list $list, %params>
574 =item C<empty_record_list>
576 Returns a rendered version (actually an instance of
577 L<SL::Presenter::EscapedText>) of an empty list of records. Is usually
578 only called by L<grouped_record_list> if its list is empty.
580 =item C<grouped_record_list $list, %params>
582 Given a number of Rose::DB objects in the array reference C<$list>
583 this function first groups them by type. Then it calls L<record_list>
584 with each non-empty type-specific sub-list and the appropriate
585 parameters for outputting a list of those records.
587 Returns a rendered version (actually an instance of
588 L<SL::Presenter::EscapedText>) of all the lists.
590 The order in which the records are grouped is:
594 =item * sales quotations
598 =item * sales delivery orders
600 =item * sales invoices
602 =item * AR transactions
604 =item * requests for quotations
606 =item * purchase orders
608 =item * purchase delivery orders
610 =item * purchase invoices
612 =item * AP transactions
614 =item * GL transactions
616 =item * SEPA collections
618 =item * SEPA transfers
622 Objects of unknown types are skipped.
624 Parameters are passed to C<record_list> include C<with_objects> and
625 C<edit_record_links>.
627 =item C<record_list $list, %params>
629 Returns a rendered version (actually an instance of
630 L<SL::Presenter::EscapedText>) of a list of records. This list
631 consists of a heading and a tabular representation of the list.
633 The parameters include:
639 Mandatory. The title to use in the heading. Must already be
644 Mandatory. An array reference of column specs to output. Each column
645 spec can be either an array reference or a hash reference.
647 If a column spec is an array reference then the first element is the
648 column's name shown in the table header. It must already be translated.
650 The second element can be either a string or a code reference. A
651 string is taken as the name of a function to call on the Rose::DB
652 object for the current row. Its return value is formatted depending on
653 the column's type (e.g. dates are output as the user expects them,
654 floating point numbers are rounded to two decimal places and
655 right-aligned etc). If it is a code reference then that code is called
656 with the object as the first argument. Its return value should be an
657 instance of L<SL::Presenter::EscapedText> and contain the rendered
658 representation of the content to output.
660 The third element, if present, can be a link to which the column will
663 If the column spec is a hash reference then the same arguments are
664 expected. The corresponding hash keys are C<title>, C<data> and
667 =item C<with_columns>
669 Can be set by the caller to indicate additional columns to
670 be listed. Currently supported:
674 =item C<record_link_destination>
676 The record link destination. Requires that the records to be listed have
677 been retrieved via the L<SL::DB::Helper::LinkedRecords> helper.
681 =item C<edit_record_links>
683 If trueish additional controls will be rendered that allow the user to
684 remove and add record links. Requires that the records to be listed have
685 been retrieved via the L<SL::DB::Helper::LinkedRecords> helper.
697 Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>