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 .= _shop_order_list( $self, $groups{shop_orders}, %params) if $groups{shop_orders};
47 $output .= _sales_quotation_list( $self, $groups{sales_quotations}, %params) if $groups{sales_quotations};
48 $output .= _sales_order_list( $self, $groups{sales_orders}, %params) if $groups{sales_orders};
49 $output .= _sales_delivery_order_list( $self, $groups{sales_delivery_orders}, %params) if $groups{sales_delivery_orders};
50 $output .= _sales_invoice_list( $self, $groups{sales_invoices}, %params) if $groups{sales_invoices};
51 $output .= _ar_transaction_list( $self, $groups{ar_transactions}, %params) if $groups{ar_transactions};
53 $output .= _request_quotation_list( $self, $groups{purchase_quotations}, %params) if $groups{purchase_quotations};
54 $output .= _purchase_order_list( $self, $groups{purchase_orders}, %params) if $groups{purchase_orders};
55 $output .= _purchase_delivery_order_list($self, $groups{purchase_delivery_orders}, %params) if $groups{purchase_delivery_orders};
56 $output .= _purchase_invoice_list( $self, $groups{purchase_invoices}, %params) if $groups{purchase_invoices};
57 $output .= _ap_transaction_list( $self, $groups{ap_transactions}, %params) if $groups{ap_transactions};
59 $output .= _gl_transaction_list( $self, $groups{gl_transactions}, %params) if $groups{gl_transactions};
61 $output .= _bank_transactions( $self, $groups{bank_transactions}, %params) if $groups{bank_transactions};
63 $output .= _sepa_collection_list( $self, $groups{sepa_collections}, %params) if $groups{sepa_collections};
64 $output .= _sepa_transfer_list( $self, $groups{sepa_transfers}, %params) if $groups{sepa_transfers};
66 $output .= _letter_list( $self, $groups{letters}, %params) if $groups{letters};
68 $output = $self->render('presenter/record/grouped_record_list', %params, output => $output);
73 sub empty_record_list {
74 my ($self, %params) = @_;
75 return $self->grouped_record_list([], %params);
79 my ($self, $list, %params) = @_;
83 if (ref($params{columns}) eq 'ARRAY') {
85 if (ref($_) eq 'ARRAY') {
86 { title => $_->[0], data => $_->[1], link => $_->[2] }
90 } @{ delete $params{columns} };
93 croak "Wrong type for 'columns' argument: not an array reference";
96 my %with_columns = map { ($_ => 1) } @{ _arrayify($params{with_columns}) };
97 if ($with_columns{record_link_direction}) {
99 title => $::locale->text('Link direction'),
101 $_[0]->{_record_link_depth} > 1
102 ? $::locale->text('Row was linked to another record')
103 : $_[0]->{_record_link_direction} eq 'from'
104 ? $::locale->text('Row was source for current record')
105 : $::locale->text('Row was created from current record') },
109 my %column_meta = map { $_->name => $_ } @{ $list->[0]->meta->columns };
110 my %relationships = map { $_->name => $_ } @{ $list->[0]->meta->relationships };
113 my ($obj, $method, @args) = @_;
114 $obj->$method(@args);
118 foreach my $obj (@{ $list }) {
121 foreach my $spec (@columns) {
124 my $method = $spec->{column} || $spec->{data};
125 my $meta = $column_meta{ $spec->{data} };
126 my $type = ref $meta;
127 my $relationship = $relationships{ $spec->{data} };
128 my $rel_type = !$relationship ? '' : $relationship->class;
129 $rel_type =~ s/^SL::DB:://;
130 $rel_type = SL::Util::snakify($rel_type);
132 if (ref($spec->{data}) eq 'CODE') {
133 $cell{value} = $spec->{data}->($obj);
136 $cell{value} = $rel_type && $self->can($rel_type) ? $self->$rel_type($obj->$method, display => 'table-cell')
137 : $type eq 'Rose::DB::Object::Metadata::Column::Date' ? $call->($obj, $method . '_as_date')
138 : $type =~ m/^Rose::DB::Object::Metadata::Column::(?:Float|Numeric|Real)$/ ? $::form->format_amount(\%::myconfig, $call->($obj, $method), 2)
139 : $type eq 'Rose::DB::Object::Metadata::Column::Boolean' ? $call->($obj, $method . '_as_bool_yn')
140 : $type =~ m/^Rose::DB::Object::Metadata::Column::(?:Integer|Serial)$/ ? $spec->{data} * 1
141 : $call->($obj, $method);
144 $cell{alignment} = 'right' if $type =~ m/int|serial|float|real|numeric/;
149 push @data, { columns => \@row, record_link => $obj->{_record_link} };
153 map +{ value => $columns[$_]->{title},
154 alignment => $data[0]->{columns}->[$_]->{alignment},
155 }, (0..scalar(@columns) - 1);
157 return $self->render(
158 'presenter/record/record_list',
160 TABLE_HEADER => \@header,
161 TABLE_ROWS => \@data,
172 requirement_specs => sub { (ref($_[0]) eq 'SL::DB::RequirementSpec') },
173 shop_orders => sub { (ref($_[0]) eq 'SL::DB::ShopOrder') && $_[0]->id },
174 sales_quotations => sub { (ref($_[0]) eq 'SL::DB::Order') && $_[0]->is_type('sales_quotation') },
175 sales_orders => sub { (ref($_[0]) eq 'SL::DB::Order') && $_[0]->is_type('sales_order') },
176 sales_delivery_orders => sub { (ref($_[0]) eq 'SL::DB::DeliveryOrder') && $_[0]->is_sales },
177 sales_invoices => sub { (ref($_[0]) eq 'SL::DB::Invoice') && $_[0]->invoice },
178 ar_transactions => sub { (ref($_[0]) eq 'SL::DB::Invoice') && !$_[0]->invoice },
179 purchase_quotations => sub { (ref($_[0]) eq 'SL::DB::Order') && $_[0]->is_type('request_quotation') },
180 purchase_orders => sub { (ref($_[0]) eq 'SL::DB::Order') && $_[0]->is_type('purchase_order') },
181 purchase_delivery_orders => sub { (ref($_[0]) eq 'SL::DB::DeliveryOrder') && !$_[0]->is_sales },
182 purchase_invoices => sub { (ref($_[0]) eq 'SL::DB::PurchaseInvoice') && $_[0]->invoice },
183 ap_transactions => sub { (ref($_[0]) eq 'SL::DB::PurchaseInvoice') && !$_[0]->invoice },
184 sepa_collections => sub { (ref($_[0]) eq 'SL::DB::SepaExportItem') && $_[0]->ar_id },
185 sepa_transfers => sub { (ref($_[0]) eq 'SL::DB::SepaExportItem') && $_[0]->ap_id },
186 gl_transactions => sub { (ref($_[0]) eq 'SL::DB::GLTransaction') },
187 bank_transactions => sub { (ref($_[0]) eq 'SL::DB::BankTransaction') && $_[0]->id },
188 letters => sub { (ref($_[0]) eq 'SL::DB::Letter') && $_[0]->id },
193 foreach my $record (@{ $list || [] }) {
194 my $type = (first { $matchers{$_}->($record) } keys %matchers) || 'other';
195 $groups{$type} ||= [];
196 push @{ $groups{$type} }, $record;
202 sub _sort_grouped_lists {
205 foreach my $group (keys %groups) {
206 next unless @{ $groups{$group} };
207 if ($groups{$group}->[0]->can('compare_to')) {
208 $groups{$group} = [ sort { $a->compare_to($b) } @{ $groups{$group} } ];
210 $groups{$group} = [ sort { $a->date <=> $b->date } @{ $groups{$group} } ];
217 sub _requirement_spec_list {
218 my ($self, $list, %params) = @_;
220 return $self->record_list(
222 title => $::locale->text('Requirement specs'),
223 type => 'requirement_spec',
225 [ $::locale->text('Requirement spec number'), sub { $self->requirement_spec($_[0], display => 'table-cell') } ],
226 [ $::locale->text('Customer'), 'customer' ],
227 [ $::locale->text('Title'), 'title' ],
228 [ $::locale->text('Project'), 'project', ],
229 [ $::locale->text('Status'), sub { $_[0]->status->description } ],
235 sub _shop_order_list {
236 my ($self, $list, %params) = @_;
238 return $self->record_list(
240 title => $::locale->text('Shop Orders'),
241 type => 'shop_order',
243 [ $::locale->text('Shop Order Date'), sub { $_[0]->order_date->to_kivitendo } ],
244 [ $::locale->text('Shop Order Number'), sub { $self->shop_order($_[0], display => 'table-cell') } ],
245 [ $::locale->text('Transfer Date'), 'transfer_date' ],
246 [ $::locale->text('Amount'), 'amount' ],
252 sub _sales_quotation_list {
253 my ($self, $list, %params) = @_;
255 return $self->record_list(
257 title => $::locale->text('Sales Quotations'),
258 type => 'sales_quotation',
260 [ $::locale->text('Quotation Date'), 'transdate' ],
261 [ $::locale->text('Quotation Number'), sub { $self->sales_quotation($_[0], display => 'table-cell') } ],
262 [ $::locale->text('Customer'), 'customer' ],
263 [ $::locale->text('Net amount'), 'netamount' ],
264 [ $::locale->text('Transaction description'), 'transaction_description' ],
265 [ $::locale->text('Project'), 'globalproject', ],
266 [ $::locale->text('Closed'), 'closed' ],
272 sub _request_quotation_list {
273 my ($self, $list, %params) = @_;
275 return $self->record_list(
277 title => $::locale->text('Request Quotations'),
278 type => 'request_quotation',
280 [ $::locale->text('Quotation Date'), 'transdate' ],
281 [ $::locale->text('Quotation Number'), sub { $self->request_quotation($_[0], display => 'table-cell') } ],
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' ],
292 sub _sales_order_list {
293 my ($self, $list, %params) = @_;
295 return $self->record_list(
297 title => $::locale->text('Sales Orders'),
298 type => 'sales_order',
300 [ $::locale->text('Order Date'), 'transdate' ],
301 [ $::locale->text('Order Number'), sub { $self->sales_order($_[0], display => 'table-cell') } ],
302 [ $::locale->text('Quotation'), 'quonumber' ],
303 [ $::locale->text('Customer'), 'customer' ],
304 [ $::locale->text('Net amount'), 'netamount' ],
305 [ $::locale->text('Transaction description'), 'transaction_description' ],
306 [ $::locale->text('Project'), 'globalproject', ],
307 [ $::locale->text('Closed'), 'closed' ],
313 sub _purchase_order_list {
314 my ($self, $list, %params) = @_;
316 return $self->record_list(
318 title => $::locale->text('Purchase Orders'),
319 type => 'purchase_order',
321 [ $::locale->text('Order Date'), 'transdate' ],
322 [ $::locale->text('Order Number'), sub { $self->purchase_order($_[0], display => 'table-cell') } ],
323 [ $::locale->text('Request for Quotation'), 'quonumber' ],
324 [ $::locale->text('Vendor'), 'vendor' ],
325 [ $::locale->text('Net amount'), 'netamount' ],
326 [ $::locale->text('Transaction description'), 'transaction_description' ],
327 [ $::locale->text('Project'), 'globalproject', ],
328 [ $::locale->text('Closed'), 'closed' ],
334 sub _sales_delivery_order_list {
335 my ($self, $list, %params) = @_;
337 return $self->record_list(
339 title => $::locale->text('Sales Delivery Orders'),
340 type => 'sales_delivery_order',
342 [ $::locale->text('Delivery Order Date'), 'transdate' ],
343 [ $::locale->text('Delivery Order Number'), sub { $self->sales_delivery_order($_[0], display => 'table-cell') } ],
344 [ $::locale->text('Order Number'), 'ordnumber' ],
345 [ $::locale->text('Customer'), 'customer' ],
346 [ $::locale->text('Transaction description'), 'transaction_description' ],
347 [ $::locale->text('Project'), 'globalproject', ],
348 [ $::locale->text('Delivered'), 'delivered' ],
349 [ $::locale->text('Closed'), 'closed' ],
355 sub _purchase_delivery_order_list {
356 my ($self, $list, %params) = @_;
358 return $self->record_list(
360 title => $::locale->text('Purchase Delivery Orders'),
361 type => 'purchase_delivery_order',
363 [ $::locale->text('Delivery Order Date'), 'transdate' ],
364 [ $::locale->text('Delivery Order Number'), sub { $self->purchase_delivery_order($_[0], display => 'table-cell') } ],
365 [ $::locale->text('Order Number'), 'ordnumber' ],
366 [ $::locale->text('Vendor'), 'vendor' ],
367 [ $::locale->text('Transaction description'), 'transaction_description' ],
368 [ $::locale->text('Project'), 'globalproject', ],
369 [ $::locale->text('Delivered'), 'delivered' ],
370 [ $::locale->text('Closed'), 'closed' ],
376 sub _sales_invoice_list {
377 my ($self, $list, %params) = @_;
379 return $self->record_list(
381 title => $::locale->text('Sales Invoices'),
382 type => 'sales_invoice',
384 [ $::locale->text('Invoice Date'), 'transdate' ],
385 [ $::locale->text('Type'), sub { $_[0]->displayable_type } ],
386 [ $::locale->text('Invoice Number'), sub { $self->sales_invoice($_[0], display => 'table-cell') } ],
387 [ $::locale->text('Quotation Number'), 'quonumber' ],
388 [ $::locale->text('Order Number'), 'ordnumber' ],
389 [ $::locale->text('Customer'), 'customer' ],
390 [ $::locale->text('Net amount'), 'netamount' ],
391 [ $::locale->text('Paid'), 'paid' ],
392 [ $::locale->text('Transaction description'), 'transaction_description' ],
398 sub _purchase_invoice_list {
399 my ($self, $list, %params) = @_;
401 return $self->record_list(
403 title => $::locale->text('Purchase Invoices'),
404 type => 'purchase_invoice',
406 [ $::locale->text('Invoice Date'), 'transdate' ],
407 [ $::locale->text('Invoice Number'), sub { $self->purchase_invoice($_[0], display => 'table-cell') } ],
408 [ $::locale->text('Request for Quotation Number'), 'quonumber' ],
409 [ $::locale->text('Order Number'), 'ordnumber' ],
410 [ $::locale->text('Vendor'), 'vendor' ],
411 [ $::locale->text('Net amount'), 'netamount' ],
412 [ $::locale->text('Paid'), 'paid' ],
413 [ $::locale->text('Transaction description'), 'transaction_description' ],
419 sub _ar_transaction_list {
420 my ($self, $list, %params) = @_;
422 return $self->record_list(
424 title => $::locale->text('AR Transactions'),
425 type => 'ar_transaction',
427 [ $::locale->text('Invoice Date'), 'transdate' ],
428 [ $::locale->text('Type'), sub { $_[0]->displayable_type } ],
429 [ $::locale->text('Invoice Number'), sub { $self->ar_transaction($_[0], display => 'table-cell') } ],
430 [ $::locale->text('Customer'), 'customer' ],
431 [ $::locale->text('Net amount'), 'netamount' ],
432 [ $::locale->text('Paid'), 'paid' ],
433 [ $::locale->text('Transaction description'), 'transaction_description' ],
439 sub _ap_transaction_list {
440 my ($self, $list, %params) = @_;
442 return $self->record_list(
444 title => $::locale->text('AP Transactions'),
445 type => 'ap_transaction',
447 [ $::locale->text('Invoice Date'), 'transdate' ],
448 [ $::locale->text('Invoice Number'), sub { $self->ap_transaction($_[0 ], display => 'table-cell') } ],
449 [ $::locale->text('Vendor'), 'vendor' ],
450 [ $::locale->text('Net amount'), 'netamount' ],
451 [ $::locale->text('Paid'), 'paid' ],
452 [ $::locale->text('Transaction description'), 'transaction_description' ],
458 sub _gl_transaction_list {
459 my ($self, $list, %params) = @_;
461 return $self->record_list(
463 title => $::locale->text('GL Transactions'),
464 type => 'gl_transaction',
466 [ $::locale->text('Transdate'), 'transdate' ],
467 [ $::locale->text('Reference'), 'reference' ],
468 [ $::locale->text('Description'), sub { $self->gl_transaction($_[0 ], display => 'table-cell') } ],
474 sub _bank_transactions {
475 my ($self, $list, %params) = @_;
477 return $self->record_list(
479 title => $::locale->text('Bank transactions'),
480 type => 'bank_transactions',
482 [ $::locale->text('Transdate'), 'transdate' ],
483 [ $::locale->text('Local Bank Code'), sub { $self->bank_code($_[0]->local_bank_account) } ],
484 [ $::locale->text('Local account number'), sub { $self->account_number($_[0]->local_bank_account) } ],
485 [ $::locale->text('Remote Bank Code'), 'remote_bank_code' ],
486 [ $::locale->text('Remote account number'),'remote_account_number' ],
487 [ $::locale->text('Valutadate'), 'valutadate' ],
488 [ $::locale->text('Amount'), 'amount' ],
489 [ $::locale->text('Currency'), sub { $_[0]->currency->name } ],
490 [ $::locale->text('Remote name'), 'remote_name' ],
491 [ $::locale->text('Purpose'), 'purpose' ],
497 sub _sepa_export_list {
498 my ($self, $list, %params) = @_;
500 my ($source, $destination) = $params{type} eq 'sepa_transfer' ? qw(our vc) : qw(vc our);
501 $params{title} = $params{type} eq 'sepa_transfer' ? $::locale->text('Bank transfers via SEPA') : $::locale->text('Bank collections via SEPA');
502 $params{with_columns} = [ grep { $_ ne 'record_link_direction' } @{ $params{with_columns} || [] } ];
504 delete $params{edit_record_links};
506 return $self->record_list(
509 [ $::locale->text('Export Number'), 'sepa_export', ],
510 [ $::locale->text('Execution date'), 'execution_date' ],
511 [ $::locale->text('Export date'), sub { $_[0]->sepa_export->itime->to_kivitendo } ],
512 [ $::locale->text('Source BIC'), "${source}_bic" ],
513 [ $::locale->text('Source IBAN'), "${source}_iban" ],
514 [ $::locale->text('Destination BIC'), "${destination}_bic" ],
515 [ $::locale->text('Destination IBAN'), "${destination}_iban" ],
516 [ $::locale->text('Amount'), 'amount' ],
522 sub _sepa_transfer_list {
523 my ($self, $list, %params) = @_;
524 _sepa_export_list($self, $list, %params, type => 'sepa_transfer');
527 sub _sepa_collection_list {
528 my ($self, $list, %params) = @_;
529 _sepa_export_list($self, $list, %params, type => 'sepa_collection');
533 my ($self, $list, %params) = @_;
535 return $self->record_list(
537 title => $::locale->text('Letters'),
540 [ $::locale->text('Date'), 'date' ],
541 [ $::locale->text('Letternumber'), sub { $self->letter($_[0], display => 'table-cell') } ],
542 [ $::locale->text('Customer'), 'customer' ],
543 [ $::locale->text('Reference'), 'reference' ],
544 [ $::locale->text('Subject'), 'subject' ],
560 SL::Presenter::Record - Presenter module for lists of
561 sales/purchase/general ledger record Rose::DB objects
565 # Retrieve a number of documents from somewhere, e.g.
566 my $order = SL::DB::Manager::Order->get_first(where => [ SL::DB::Manager::Order->type_filter('sales_order') ]);
567 my $records = $order->linked_records(destination => 'to');
569 # Give HTML representation:
570 my $html = SL::Presenter->get->grouped_record_list($records);
582 Returns a rendered version (actually an instance of
583 L<SL::Presenter::EscapedText>) of a single ar, ap or gl object.
586 # fetch the record from a random acc_trans object and print its link (could be ar, ap or gl)
587 my $record = SL::DB::Manager::AccTransaction->get_first()->record;
588 my $html = SL::Presenter->get->record($record, display => 'inline');
590 =item C<grouped_record_list $list, %params>
592 =item C<empty_record_list>
594 Returns a rendered version (actually an instance of
595 L<SL::Presenter::EscapedText>) of an empty list of records. Is usually
596 only called by L<grouped_record_list> if its list is empty.
598 =item C<grouped_record_list $list, %params>
600 Given a number of Rose::DB objects in the array reference C<$list>
601 this function first groups them by type. Then it calls L<record_list>
602 with each non-empty type-specific sub-list and the appropriate
603 parameters for outputting a list of those records.
605 Returns a rendered version (actually an instance of
606 L<SL::Presenter::EscapedText>) of all the lists.
608 The order in which the records are grouped is:
612 =item * sales quotations
616 =item * sales delivery orders
618 =item * sales invoices
620 =item * AR transactions
622 =item * requests for quotations
624 =item * purchase orders
626 =item * purchase delivery orders
628 =item * purchase invoices
630 =item * AP transactions
632 =item * GL transactions
634 =item * SEPA collections
636 =item * SEPA transfers
640 Objects of unknown types are skipped.
642 Parameters are passed to C<record_list> include C<with_objects> and
643 C<edit_record_links>.
645 =item C<record_list $list, %params>
647 Returns a rendered version (actually an instance of
648 L<SL::Presenter::EscapedText>) of a list of records. This list
649 consists of a heading and a tabular representation of the list.
651 The parameters include:
657 Mandatory. The title to use in the heading. Must already be
662 Mandatory. An array reference of column specs to output. Each column
663 spec can be either an array reference or a hash reference.
665 If a column spec is an array reference then the first element is the
666 column's name shown in the table header. It must already be translated.
668 The second element can be either a string or a code reference. A
669 string is taken as the name of a function to call on the Rose::DB
670 object for the current row. Its return value is formatted depending on
671 the column's type (e.g. dates are output as the user expects them,
672 floating point numbers are rounded to two decimal places and
673 right-aligned etc). If it is a code reference then that code is called
674 with the object as the first argument. Its return value should be an
675 instance of L<SL::Presenter::EscapedText> and contain the rendered
676 representation of the content to output.
678 The third element, if present, can be a link to which the column will
681 If the column spec is a hash reference then the same arguments are
682 expected. The corresponding hash keys are C<title>, C<data> and
685 =item C<with_columns>
687 Can be set by the caller to indicate additional columns to
688 be listed. Currently supported:
692 =item C<record_link_destination>
694 The record link destination. Requires that the records to be listed have
695 been retrieved via the L<SL::DB::Helper::LinkedRecords> helper.
699 =item C<edit_record_links>
701 If trueish additional controls will be rendered that allow the user to
702 remove and add record links. Requires that the records to be listed have
703 been retrieved via the L<SL::DB::Helper::LinkedRecords> helper.
715 Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>