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 .= _bank_transactions( $self, $groups{bank_transactions}, %params) if $groups{bank_transactions};
60 $output .= _sepa_collection_list( $self, $groups{sepa_collections}, %params) if $groups{sepa_collections};
61 $output .= _sepa_transfer_list( $self, $groups{sepa_transfers}, %params) if $groups{sepa_transfers};
63 $output = $self->render('presenter/record/grouped_record_list', %params, output => $output);
68 sub empty_record_list {
69 my ($self, %params) = @_;
70 return $self->grouped_record_list([], %params);
74 my ($self, $list, %params) = @_;
78 if (ref($params{columns}) eq 'ARRAY') {
80 if (ref($_) eq 'ARRAY') {
81 { title => $_->[0], data => $_->[1], link => $_->[2] }
85 } @{ delete $params{columns} };
88 croak "Wrong type for 'columns' argument: not an array reference";
91 my %with_columns = map { ($_ => 1) } @{ _arrayify($params{with_columns}) };
92 if ($with_columns{record_link_direction}) {
94 title => $::locale->text('Link direction'),
96 $_[0]->{_record_link_depth} > 1
97 ? $::locale->text('Row was linked to another record')
98 : $_[0]->{_record_link_direction} eq 'from'
99 ? $::locale->text('Row was source for current record')
100 : $::locale->text('Row was created from current record') },
104 my %column_meta = map { $_->name => $_ } @{ $list->[0]->meta->columns };
105 my %relationships = map { $_->name => $_ } @{ $list->[0]->meta->relationships };
108 my ($obj, $method, @args) = @_;
109 $obj->$method(@args);
113 foreach my $obj (@{ $list }) {
116 foreach my $spec (@columns) {
119 my $method = $spec->{column} || $spec->{data};
120 my $meta = $column_meta{ $spec->{data} };
121 my $type = ref $meta;
122 my $relationship = $relationships{ $spec->{data} };
123 my $rel_type = !$relationship ? '' : $relationship->class;
124 $rel_type =~ s/^SL::DB:://;
125 $rel_type = SL::Util::snakify($rel_type);
127 if (ref($spec->{data}) eq 'CODE') {
128 $cell{value} = $spec->{data}->($obj);
131 $cell{value} = $rel_type && $self->can($rel_type) ? $self->$rel_type($obj->$method, display => 'table-cell')
132 : $type eq 'Rose::DB::Object::Metadata::Column::Date' ? $call->($obj, $method . '_as_date')
133 : $type =~ m/^Rose::DB::Object::Metadata::Column::(?:Float|Numeric|Real)$/ ? $::form->format_amount(\%::myconfig, $call->($obj, $method), 2)
134 : $type eq 'Rose::DB::Object::Metadata::Column::Boolean' ? $call->($obj, $method . '_as_bool_yn')
135 : $type =~ m/^Rose::DB::Object::Metadata::Column::(?:Integer|Serial)$/ ? $spec->{data} * 1
136 : $call->($obj, $method);
139 $cell{alignment} = 'right' if $type =~ m/int|serial|float|real|numeric/;
144 push @data, { columns => \@row, record_link => $obj->{_record_link} };
148 map +{ value => $columns[$_]->{title},
149 alignment => $data[0]->{columns}->[$_]->{alignment},
150 }, (0..scalar(@columns) - 1);
152 return $self->render(
153 'presenter/record/record_list',
155 TABLE_HEADER => \@header,
156 TABLE_ROWS => \@data,
168 requirement_specs => sub { (ref($_[0]) eq 'SL::DB::RequirementSpec') },
169 sales_quotations => sub { (ref($_[0]) eq 'SL::DB::Order') && $_[0]->is_type('sales_quotation') },
170 sales_orders => sub { (ref($_[0]) eq 'SL::DB::Order') && $_[0]->is_type('sales_order') },
171 sales_delivery_orders => sub { (ref($_[0]) eq 'SL::DB::DeliveryOrder') && $_[0]->is_sales },
172 sales_invoices => sub { (ref($_[0]) eq 'SL::DB::Invoice') && $_[0]->invoice },
173 ar_transactions => sub { (ref($_[0]) eq 'SL::DB::Invoice') && !$_[0]->invoice },
174 purchase_quotations => sub { (ref($_[0]) eq 'SL::DB::Order') && $_[0]->is_type('request_quotation') },
175 purchase_orders => sub { (ref($_[0]) eq 'SL::DB::Order') && $_[0]->is_type('purchase_order') },
176 purchase_delivery_orders => sub { (ref($_[0]) eq 'SL::DB::DeliveryOrder') && !$_[0]->is_sales },
177 purchase_invoices => sub { (ref($_[0]) eq 'SL::DB::PurchaseInvoice') && $_[0]->invoice },
178 ap_transactions => sub { (ref($_[0]) eq 'SL::DB::PurchaseInvoice') && !$_[0]->invoice },
179 sepa_collections => sub { (ref($_[0]) eq 'SL::DB::SepaExportItem') && $_[0]->ar_id },
180 sepa_transfers => sub { (ref($_[0]) eq 'SL::DB::SepaExportItem') && $_[0]->ap_id },
181 gl_transactions => sub { (ref($_[0]) eq 'SL::DB::GLTransaction') },
182 bank_transactions => sub { (ref($_[0]) eq 'SL::DB::BankTransaction') && $_[0]->id },
187 foreach my $record (@{ $list || [] }) {
188 my $type = (first { $matchers{$_}->($record) } keys %matchers) || 'other';
189 $groups{$type} ||= [];
190 push @{ $groups{$type} }, $record;
196 sub _sort_grouped_lists {
199 foreach my $group (keys %groups) {
200 next unless @{ $groups{$group} };
201 if ($groups{$group}->[0]->can('compare_to')) {
202 $groups{$group} = [ sort { $a->compare_to($b) } @{ $groups{$group} } ];
204 $groups{$group} = [ sort { $a->date <=> $b->date } @{ $groups{$group} } ];
211 sub _requirement_spec_list {
212 my ($self, $list, %params) = @_;
214 return $self->record_list(
216 title => $::locale->text('Requirement specs'),
217 type => 'requirement_spec',
219 [ $::locale->text('Requirement spec number'), sub { $self->requirement_spec($_[0], display => 'table-cell') } ],
220 [ $::locale->text('Customer'), 'customer' ],
221 [ $::locale->text('Title'), 'title' ],
222 [ $::locale->text('Project'), 'project', ],
223 [ $::locale->text('Status'), sub { $_[0]->status->description } ],
229 sub _sales_quotation_list {
230 my ($self, $list, %params) = @_;
232 return $self->record_list(
234 title => $::locale->text('Sales Quotations'),
235 type => 'sales_quotation',
237 [ $::locale->text('Quotation Date'), 'transdate' ],
238 [ $::locale->text('Quotation Number'), sub { $self->sales_quotation($_[0], display => 'table-cell') } ],
239 [ $::locale->text('Customer'), 'customer' ],
240 [ $::locale->text('Net amount'), 'netamount' ],
241 [ $::locale->text('Transaction description'), 'transaction_description' ],
242 [ $::locale->text('Project'), 'globalproject', ],
243 [ $::locale->text('Closed'), 'closed' ],
249 sub _request_quotation_list {
250 my ($self, $list, %params) = @_;
252 return $self->record_list(
254 title => $::locale->text('Request Quotations'),
255 type => 'request_quotation',
257 [ $::locale->text('Quotation Date'), 'transdate' ],
258 [ $::locale->text('Quotation Number'), sub { $self->request_quotation($_[0], display => 'table-cell') } ],
259 [ $::locale->text('Vendor'), 'vendor' ],
260 [ $::locale->text('Net amount'), 'netamount' ],
261 [ $::locale->text('Transaction description'), 'transaction_description' ],
262 [ $::locale->text('Project'), 'globalproject', ],
263 [ $::locale->text('Closed'), 'closed' ],
269 sub _sales_order_list {
270 my ($self, $list, %params) = @_;
272 return $self->record_list(
274 title => $::locale->text('Sales Orders'),
275 type => 'sales_order',
277 [ $::locale->text('Order Date'), 'transdate' ],
278 [ $::locale->text('Order Number'), sub { $self->sales_order($_[0], display => 'table-cell') } ],
279 [ $::locale->text('Quotation'), 'quonumber' ],
280 [ $::locale->text('Customer'), 'customer' ],
281 [ $::locale->text('Net amount'), 'netamount' ],
282 [ $::locale->text('Transaction description'), 'transaction_description' ],
283 [ $::locale->text('Project'), 'globalproject', ],
284 [ $::locale->text('Closed'), 'closed' ],
290 sub _purchase_order_list {
291 my ($self, $list, %params) = @_;
293 return $self->record_list(
295 title => $::locale->text('Purchase Orders'),
296 type => 'purchase_order',
298 [ $::locale->text('Order Date'), 'transdate' ],
299 [ $::locale->text('Order Number'), sub { $self->purchase_order($_[0], display => 'table-cell') } ],
300 [ $::locale->text('Request for Quotation'), 'quonumber' ],
301 [ $::locale->text('Vendor'), 'vendor' ],
302 [ $::locale->text('Net amount'), 'netamount' ],
303 [ $::locale->text('Transaction description'), 'transaction_description' ],
304 [ $::locale->text('Project'), 'globalproject', ],
305 [ $::locale->text('Closed'), 'closed' ],
311 sub _sales_delivery_order_list {
312 my ($self, $list, %params) = @_;
314 return $self->record_list(
316 title => $::locale->text('Sales Delivery Orders'),
317 type => 'sales_delivery_order',
319 [ $::locale->text('Delivery Order Date'), 'transdate' ],
320 [ $::locale->text('Delivery Order Number'), sub { $self->sales_delivery_order($_[0], display => 'table-cell') } ],
321 [ $::locale->text('Order Number'), 'ordnumber' ],
322 [ $::locale->text('Customer'), 'customer' ],
323 [ $::locale->text('Transaction description'), 'transaction_description' ],
324 [ $::locale->text('Project'), 'globalproject', ],
325 [ $::locale->text('Delivered'), 'delivered' ],
326 [ $::locale->text('Closed'), 'closed' ],
332 sub _purchase_delivery_order_list {
333 my ($self, $list, %params) = @_;
335 return $self->record_list(
337 title => $::locale->text('Purchase Delivery Orders'),
338 type => 'purchase_delivery_order',
340 [ $::locale->text('Delivery Order Date'), 'transdate' ],
341 [ $::locale->text('Delivery Order Number'), sub { $self->purchase_delivery_order($_[0], display => 'table-cell') } ],
342 [ $::locale->text('Order Number'), 'ordnumber' ],
343 [ $::locale->text('Vendor'), 'vendor' ],
344 [ $::locale->text('Transaction description'), 'transaction_description' ],
345 [ $::locale->text('Project'), 'globalproject', ],
346 [ $::locale->text('Delivered'), 'delivered' ],
347 [ $::locale->text('Closed'), 'closed' ],
353 sub _sales_invoice_list {
354 my ($self, $list, %params) = @_;
356 return $self->record_list(
358 title => $::locale->text('Sales Invoices'),
359 type => 'sales_invoice',
361 [ $::locale->text('Invoice Date'), 'transdate' ],
362 [ $::locale->text('Type'), sub { $_[0]->displayable_type } ],
363 [ $::locale->text('Invoice Number'), sub { $self->sales_invoice($_[0], display => 'table-cell') } ],
364 [ $::locale->text('Quotation Number'), 'quonumber' ],
365 [ $::locale->text('Order Number'), 'ordnumber' ],
366 [ $::locale->text('Customer'), 'customer' ],
367 [ $::locale->text('Net amount'), 'netamount' ],
368 [ $::locale->text('Paid'), 'paid' ],
369 [ $::locale->text('Transaction description'), 'transaction_description' ],
375 sub _purchase_invoice_list {
376 my ($self, $list, %params) = @_;
378 return $self->record_list(
380 title => $::locale->text('Purchase Invoices'),
381 type => 'purchase_invoice',
383 [ $::locale->text('Invoice Date'), 'transdate' ],
384 [ $::locale->text('Invoice Number'), sub { $self->purchase_invoice($_[0], display => 'table-cell') } ],
385 [ $::locale->text('Request for Quotation Number'), 'quonumber' ],
386 [ $::locale->text('Order Number'), 'ordnumber' ],
387 [ $::locale->text('Vendor'), 'vendor' ],
388 [ $::locale->text('Net amount'), 'netamount' ],
389 [ $::locale->text('Paid'), 'paid' ],
390 [ $::locale->text('Transaction description'), 'transaction_description' ],
396 sub _ar_transaction_list {
397 my ($self, $list, %params) = @_;
399 return $self->record_list(
401 title => $::locale->text('AR Transactions'),
402 type => 'ar_transaction',
404 [ $::locale->text('Invoice Date'), 'transdate' ],
405 [ $::locale->text('Type'), sub { $_[0]->displayable_type } ],
406 [ $::locale->text('Invoice Number'), sub { $self->ar_transaction($_[0], display => 'table-cell') } ],
407 [ $::locale->text('Customer'), 'customer' ],
408 [ $::locale->text('Net amount'), 'netamount' ],
409 [ $::locale->text('Paid'), 'paid' ],
410 [ $::locale->text('Transaction description'), 'transaction_description' ],
416 sub _ap_transaction_list {
417 my ($self, $list, %params) = @_;
419 return $self->record_list(
421 title => $::locale->text('AP Transactions'),
422 type => 'ap_transaction',
424 [ $::locale->text('Invoice Date'), 'transdate' ],
425 [ $::locale->text('Invoice Number'), sub { $self->ap_transaction($_[0 ], display => 'table-cell') } ],
426 [ $::locale->text('Vendor'), 'vendor' ],
427 [ $::locale->text('Net amount'), 'netamount' ],
428 [ $::locale->text('Paid'), 'paid' ],
429 [ $::locale->text('Transaction description'), 'transaction_description' ],
435 sub _bank_transactions {
436 my ($self, $list, %params) = @_;
438 return $self->record_list(
440 title => $::locale->text('Bank transactions'),
441 type => 'bank_transactions',
443 [ $::locale->text('Transdate'), 'transdate' ],
444 [ $::locale->text('Local Bank Code'), sub { $self->bank_code($_[0]->local_bank_account) } ],
445 [ $::locale->text('Local account number'), sub { $self->account_number($_[0]->local_bank_account) } ],
446 [ $::locale->text('Remote Bank Code'), 'remote_bank_code' ],
447 [ $::locale->text('Remote account number'),'remote_account_number' ],
448 [ $::locale->text('Valutadate'), 'valutadate' ],
449 [ $::locale->text('Amount'), 'amount' ],
450 [ $::locale->text('Currency'), sub { $_[0]->currency->name } ],
451 [ $::locale->text('Remote name'), 'remote_name' ],
452 [ $::locale->text('Purpose'), 'purpose' ],
458 sub _sepa_export_list {
459 my ($self, $list, %params) = @_;
461 my ($source, $destination) = $params{type} eq 'sepa_transfer' ? qw(our vc) : qw(vc our);
462 $params{title} = $params{type} eq 'sepa_transfer' ? $::locale->text('Bank transfers via SEPA') : $::locale->text('Bank collections via SEPA');
463 $params{with_columns} = [ grep { $_ ne 'record_link_direction' } @{ $params{with_columns} || [] } ];
465 delete $params{edit_record_links};
467 return $self->record_list(
470 [ $::locale->text('Export Number'), 'sepa_export', ],
471 [ $::locale->text('Execution date'), 'execution_date' ],
472 [ $::locale->text('Export date'), sub { $_[0]->sepa_export->itime->to_kivitendo } ],
473 [ $::locale->text('Source BIC'), "${source}_bic" ],
474 [ $::locale->text('Source IBAN'), "${source}_iban" ],
475 [ $::locale->text('Destination BIC'), "${destination}_bic" ],
476 [ $::locale->text('Destination IBAN'), "${destination}_iban" ],
477 [ $::locale->text('Amount'), 'amount' ],
483 sub _sepa_transfer_list {
484 my ($self, $list, %params) = @_;
485 _sepa_export_list($self, $list, %params, type => 'sepa_transfer');
488 sub _sepa_collection_list {
489 my ($self, $list, %params) = @_;
490 _sepa_export_list($self, $list, %params, type => 'sepa_collection');
503 SL::Presenter::Record - Presenter module for lists of
504 sales/purchase/general ledger record Rose::DB objects
508 # Retrieve a number of documents from somewhere, e.g.
509 my $order = SL::DB::Manager::Order->get_first(where => [ SL::DB::Manager::Order->type_filter('sales_order') ]);
510 my $records = $order->linked_records(destination => 'to');
512 # Give HTML representation:
513 my $html = SL::Presenter->get->grouped_record_list($records);
525 Returns a rendered version (actually an instance of
526 L<SL::Presenter::EscapedText>) of a single ar, ap or gl object.
529 # fetch the record from a random acc_trans object and print its link (could be ar, ap or gl)
530 my $record = SL::DB::Manager::AccTransaction->get_first()->record;
531 my $html = SL::Presenter->get->record($record, display => 'inline');
533 =item C<grouped_record_list $list, %params>
535 =item C<empty_record_list>
537 Returns a rendered version (actually an instance of
538 L<SL::Presenter::EscapedText>) of an empty list of records. Is usually
539 only called by L<grouped_record_list> if its list is empty.
541 =item C<grouped_record_list $list, %params>
543 Given a number of Rose::DB objects in the array reference C<$list>
544 this function first groups them by type. Then it calls L<record_list>
545 with each non-empty type-specific sub-list and the appropriate
546 parameters for outputting a list of those records.
548 Returns a rendered version (actually an instance of
549 L<SL::Presenter::EscapedText>) of all the lists.
551 The order in which the records are grouped is:
555 =item * sales quotations
559 =item * sales delivery orders
561 =item * sales invoices
563 =item * AR transactions
565 =item * requests for quotations
567 =item * purchase orders
569 =item * purchase delivery orders
571 =item * purchase invoices
573 =item * AP transactions
575 =item * SEPA collections
577 =item * SEPA transfers
581 Objects of unknown types are skipped.
583 Parameters are passed to C<record_list> include C<with_objects> and
584 C<edit_record_links>.
586 =item C<record_list $list, %params>
588 Returns a rendered version (actually an instance of
589 L<SL::Presenter::EscapedText>) of a list of records. This list
590 consists of a heading and a tabular representation of the list.
592 The parameters include:
598 Mandatory. The title to use in the heading. Must already be
603 Mandatory. An array reference of column specs to output. Each column
604 spec can be either an array reference or a hash reference.
606 If a column spec is an array reference then the first element is the
607 column's name shown in the table header. It must already be translated.
609 The second element can be either a string or a code reference. A
610 string is taken as the name of a function to call on the Rose::DB
611 object for the current row. Its return value is formatted depending on
612 the column's type (e.g. dates are output as the user expects them,
613 floating point numbers are rounded to two decimal places and
614 right-aligned etc). If it is a code reference then that code is called
615 with the object as the first argument. Its return value should be an
616 instance of L<SL::Presenter::EscapedText> and contain the rendered
617 representation of the content to output.
619 The third element, if present, can be a link to which the column will
622 If the column spec is a hash reference then the same arguments are
623 expected. The corresponding hash keys are C<title>, C<data> and
626 =item C<with_columns>
628 Can be set by the caller to indicate additional columns to
629 be listed. Currently supported:
633 =item C<record_link_destination>
635 The record link destination. Requires that the records to be listed have
636 been retrieved via the L<SL::DB::Helper::LinkedRecords> helper.
640 =item C<edit_record_links>
642 If trueish additional controls will be rendered that allow the user to
643 remove and add record links. Requires that the records to be listed have
644 been retrieved via the L<SL::DB::Helper::LinkedRecords> helper.
656 Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>