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);
13 use List::Util qw(first);
17 return [] if !defined $array;
18 return $array if ref $array;
22 sub grouped_record_list {
23 my ($self, $list, %params) = @_;
25 %params = map { exists $params{$_} ? ($_ => $params{$_}) : () } qw(edit_record_links with_columns object_id object_model);
27 my %groups = _sort_grouped_lists(_group_records($list));
30 $output .= _requirement_spec_list( $self, $groups{requirement_specs}, %params) if $groups{requirement_specs};
31 $output .= _sales_quotation_list( $self, $groups{sales_quotations}, %params) if $groups{sales_quotations};
32 $output .= _sales_order_list( $self, $groups{sales_orders}, %params) if $groups{sales_orders};
33 $output .= _sales_delivery_order_list( $self, $groups{sales_delivery_orders}, %params) if $groups{sales_delivery_orders};
34 $output .= _sales_invoice_list( $self, $groups{sales_invoices}, %params) if $groups{sales_invoices};
35 $output .= _ar_transaction_list( $self, $groups{ar_transactions}, %params) if $groups{ar_transactions};
37 $output .= _request_quotation_list( $self, $groups{purchase_quotations}, %params) if $groups{purchase_quotations};
38 $output .= _purchase_order_list( $self, $groups{purchase_orders}, %params) if $groups{purchase_orders};
39 $output .= _purchase_delivery_order_list($self, $groups{purchase_delivery_orders}, %params) if $groups{purchase_delivery_orders};
40 $output .= _purchase_invoice_list( $self, $groups{purchase_invoices}, %params) if $groups{purchase_invoices};
41 $output .= _ap_transaction_list( $self, $groups{ap_transactions}, %params) if $groups{ap_transactions};
43 $output .= _sepa_collection_list( $self, $groups{sepa_collections}, %params) if $groups{sepa_collections};
44 $output .= _sepa_transfer_list( $self, $groups{sepa_transfers}, %params) if $groups{sepa_transfers};
46 $output = $self->render('presenter/record/grouped_record_list', %params, output => $output);
51 sub empty_record_list {
52 my ($self, %params) = @_;
53 return $self->grouped_record_list([], %params);
57 my ($self, $list, %params) = @_;
61 if (ref($params{columns}) eq 'ARRAY') {
63 if (ref($_) eq 'ARRAY') {
64 { title => $_->[0], data => $_->[1], link => $_->[2] }
68 } @{ delete $params{columns} };
71 croak "Wrong type for 'columns' argument: not an array reference";
74 my %with_columns = map { ($_ => 1) } @{ _arrayify($params{with_columns}) };
75 if ($with_columns{record_link_direction}) {
77 title => $::locale->text('Link direction'),
78 data => sub { $_[0]->{_record_link_direction} eq 'from' ? $::locale->text('Row was source for current record') : $::locale->text('Row was created from current record') },
82 my %column_meta = map { $_->name => $_ } @{ $list->[0]->meta->columns };
83 my %relationships = map { $_->name => $_ } @{ $list->[0]->meta->relationships };
86 my ($obj, $method, @args) = @_;
91 foreach my $obj (@{ $list }) {
94 foreach my $spec (@columns) {
97 my $method = $spec->{column} || $spec->{data};
98 my $meta = $column_meta{ $spec->{data} };
100 my $relationship = $relationships{ $spec->{data} };
101 my $rel_type = !$relationship ? '' : $relationship->class;
102 $rel_type =~ s/^SL::DB:://;
103 $rel_type = SL::Util::snakify($rel_type);
105 if (ref($spec->{data}) eq 'CODE') {
106 $cell{value} = $spec->{data}->($obj);
109 $cell{value} = $rel_type && $self->can($rel_type) ? $self->$rel_type($obj->$method, display => 'table-cell')
110 : $type eq 'Rose::DB::Object::Metadata::Column::Date' ? $call->($obj, $method . '_as_date')
111 : $type =~ m/^Rose::DB::Object::Metadata::Column::(?:Float|Numeric|Real)$/ ? $::form->format_amount(\%::myconfig, $call->($obj, $method), 2)
112 : $type eq 'Rose::DB::Object::Metadata::Column::Boolean' ? $call->($obj, $method . '_as_bool_yn')
113 : $type =~ m/^Rose::DB::Object::Metadata::Column::(?:Integer|Serial)$/ ? $spec->{data} * 1
114 : $call->($obj, $method);
117 $cell{alignment} = 'right' if $type =~ m/int|serial|float|real|numeric/;
122 push @data, { columns => \@row, record_link => $obj->{_record_link} };
126 map +{ value => $columns[$_]->{title},
127 alignment => $data[0]->{columns}->[$_]->{alignment},
128 }, (0..scalar(@columns) - 1);
130 return $self->render(
131 'presenter/record/record_list',
133 TABLE_HEADER => \@header,
134 TABLE_ROWS => \@data,
146 requirement_specs => sub { (ref($_[0]) eq 'SL::DB::RequirementSpec') },
147 sales_quotations => sub { (ref($_[0]) eq 'SL::DB::Order') && $_[0]->is_type('sales_quotation') },
148 sales_orders => sub { (ref($_[0]) eq 'SL::DB::Order') && $_[0]->is_type('sales_order') },
149 sales_delivery_orders => sub { (ref($_[0]) eq 'SL::DB::DeliveryOrder') && $_[0]->is_sales },
150 sales_invoices => sub { (ref($_[0]) eq 'SL::DB::Invoice') && $_[0]->invoice },
151 ar_transactions => sub { (ref($_[0]) eq 'SL::DB::Invoice') && !$_[0]->invoice },
152 purchase_quotations => sub { (ref($_[0]) eq 'SL::DB::Order') && $_[0]->is_type('request_quotation') },
153 purchase_orders => sub { (ref($_[0]) eq 'SL::DB::Order') && $_[0]->is_type('purchase_order') },
154 purchase_delivery_orders => sub { (ref($_[0]) eq 'SL::DB::DeliveryOrder') && !$_[0]->is_sales },
155 purchase_invoices => sub { (ref($_[0]) eq 'SL::DB::PurchaseInvoice') && $_[0]->invoice },
156 ap_transactions => sub { (ref($_[0]) eq 'SL::DB::PurchaseInvoice') && !$_[0]->invoice },
157 sepa_collections => sub { (ref($_[0]) eq 'SL::DB::SepaExportItem') && $_[0]->ar_id },
158 sepa_transfers => sub { (ref($_[0]) eq 'SL::DB::SepaExportItem') && $_[0]->ap_id },
163 foreach my $record (@{ $list || [] }) {
164 my $type = (first { $matchers{$_}->($record) } keys %matchers) || 'other';
165 $groups{$type} ||= [];
166 push @{ $groups{$type} }, $record;
172 sub _sort_grouped_lists {
175 foreach my $group (keys %groups) {
176 next unless @{ $groups{$group} };
177 if ($groups{$group}->[0]->can('compare_to')) {
178 $groups{$group} = [ sort { $a->compare_to($b) } @{ $groups{$group} } ];
180 $groups{$group} = [ sort { $a->date <=> $b->date } @{ $groups{$group} } ];
187 sub _requirement_spec_list {
188 my ($self, $list, %params) = @_;
190 return $self->record_list(
192 title => $::locale->text('Requirement specs'),
193 type => 'requirement_spec',
195 [ $::locale->text('Requirement spec number'), sub { $self->requirement_spec($_[0], display => 'table-cell') } ],
196 [ $::locale->text('Customer'), 'customer' ],
197 [ $::locale->text('Title'), 'title' ],
198 [ $::locale->text('Project'), 'project', ],
199 [ $::locale->text('Status'), sub { $_[0]->status->description } ],
205 sub _sales_quotation_list {
206 my ($self, $list, %params) = @_;
208 return $self->record_list(
210 title => $::locale->text('Sales Quotations'),
211 type => 'sales_quotation',
213 [ $::locale->text('Quotation Date'), 'transdate' ],
214 [ $::locale->text('Quotation Number'), sub { $self->sales_quotation($_[0], display => 'table-cell') } ],
215 [ $::locale->text('Customer'), 'customer' ],
216 [ $::locale->text('Net amount'), 'netamount' ],
217 [ $::locale->text('Transaction description'), 'transaction_description' ],
218 [ $::locale->text('Project'), 'globalproject', ],
219 [ $::locale->text('Closed'), 'closed' ],
225 sub _request_quotation_list {
226 my ($self, $list, %params) = @_;
228 return $self->record_list(
230 title => $::locale->text('Request Quotations'),
231 type => 'request_quotation',
233 [ $::locale->text('Quotation Date'), 'transdate' ],
234 [ $::locale->text('Quotation Number'), sub { $self->request_quotation($_[0], display => 'table-cell') } ],
235 [ $::locale->text('Vendor'), 'vendor' ],
236 [ $::locale->text('Net amount'), 'netamount' ],
237 [ $::locale->text('Transaction description'), 'transaction_description' ],
238 [ $::locale->text('Project'), 'globalproject', ],
239 [ $::locale->text('Closed'), 'closed' ],
245 sub _sales_order_list {
246 my ($self, $list, %params) = @_;
248 return $self->record_list(
250 title => $::locale->text('Sales Orders'),
251 type => 'sales_order',
253 [ $::locale->text('Order Date'), 'transdate' ],
254 [ $::locale->text('Order Number'), sub { $self->sales_order($_[0], display => 'table-cell') } ],
255 [ $::locale->text('Quotation'), 'quonumber' ],
256 [ $::locale->text('Customer'), 'customer' ],
257 [ $::locale->text('Net amount'), 'netamount' ],
258 [ $::locale->text('Transaction description'), 'transaction_description' ],
259 [ $::locale->text('Project'), 'globalproject', ],
260 [ $::locale->text('Closed'), 'closed' ],
266 sub _purchase_order_list {
267 my ($self, $list, %params) = @_;
269 return $self->record_list(
271 title => $::locale->text('Purchase Orders'),
272 type => 'purchase_order',
274 [ $::locale->text('Order Date'), 'transdate' ],
275 [ $::locale->text('Order Number'), sub { $self->purchase_order($_[0], display => 'table-cell') } ],
276 [ $::locale->text('Request for Quotation'), 'quonumber' ],
277 [ $::locale->text('Vendor'), 'vendor' ],
278 [ $::locale->text('Net amount'), 'netamount' ],
279 [ $::locale->text('Transaction description'), 'transaction_description' ],
280 [ $::locale->text('Project'), 'globalproject', ],
281 [ $::locale->text('Closed'), 'closed' ],
287 sub _sales_delivery_order_list {
288 my ($self, $list, %params) = @_;
290 return $self->record_list(
292 title => $::locale->text('Sales Delivery Orders'),
293 type => 'sales_delivery_order',
295 [ $::locale->text('Delivery Order Date'), 'transdate' ],
296 [ $::locale->text('Delivery Order Number'), sub { $self->sales_delivery_order($_[0], display => 'table-cell') } ],
297 [ $::locale->text('Order Number'), 'ordnumber' ],
298 [ $::locale->text('Customer'), 'customer' ],
299 [ $::locale->text('Transaction description'), 'transaction_description' ],
300 [ $::locale->text('Project'), 'globalproject', ],
301 [ $::locale->text('Delivered'), 'delivered' ],
302 [ $::locale->text('Closed'), 'closed' ],
308 sub _purchase_delivery_order_list {
309 my ($self, $list, %params) = @_;
311 return $self->record_list(
313 title => $::locale->text('Purchase Delivery Orders'),
314 type => 'purchase_delivery_order',
316 [ $::locale->text('Delivery Order Date'), 'transdate' ],
317 [ $::locale->text('Delivery Order Number'), sub { $self->purchase_delivery_order($_[0], display => 'table-cell') } ],
318 [ $::locale->text('Order Number'), 'ordnumber' ],
319 [ $::locale->text('Vendor'), 'vendor' ],
320 [ $::locale->text('Transaction description'), 'transaction_description' ],
321 [ $::locale->text('Project'), 'globalproject', ],
322 [ $::locale->text('Delivered'), 'delivered' ],
323 [ $::locale->text('Closed'), 'closed' ],
329 sub _sales_invoice_list {
330 my ($self, $list, %params) = @_;
332 return $self->record_list(
334 title => $::locale->text('Sales Invoices'),
335 type => 'sales_invoice',
337 [ $::locale->text('Invoice Date'), 'transdate' ],
338 [ $::locale->text('Invoice Number'), sub { $self->sales_invoice($_[0], display => 'table-cell') } ],
339 [ $::locale->text('Quotation Number'), 'quonumber' ],
340 [ $::locale->text('Order Number'), 'ordnumber' ],
341 [ $::locale->text('Customer'), 'customer' ],
342 [ $::locale->text('Net amount'), 'netamount' ],
343 [ $::locale->text('Paid'), 'paid' ],
344 [ $::locale->text('Transaction description'), 'transaction_description' ],
350 sub _purchase_invoice_list {
351 my ($self, $list, %params) = @_;
353 return $self->record_list(
355 title => $::locale->text('Purchase Invoices'),
356 type => 'purchase_invoice',
358 [ $::locale->text('Invoice Date'), 'transdate' ],
359 [ $::locale->text('Invoice Number'), sub { $self->purchase_invoice($_[0], display => 'table-cell') } ],
360 [ $::locale->text('Request for Quotation Number'), 'quonumber' ],
361 [ $::locale->text('Order Number'), 'ordnumber' ],
362 [ $::locale->text('Vendor'), 'vendor' ],
363 [ $::locale->text('Net amount'), 'netamount' ],
364 [ $::locale->text('Paid'), 'paid' ],
365 [ $::locale->text('Transaction description'), 'transaction_description' ],
371 sub _ar_transaction_list {
372 my ($self, $list, %params) = @_;
374 return $self->record_list(
376 title => $::locale->text('AR Transactions'),
377 type => 'ar_transaction',
379 [ $::locale->text('Invoice Date'), 'transdate' ],
380 [ $::locale->text('Invoice Number'), sub { $self->ar_transaction($_[0], display => 'table-cell') } ],
381 [ $::locale->text('Customer'), 'customer' ],
382 [ $::locale->text('Net amount'), 'netamount' ],
383 [ $::locale->text('Paid'), 'paid' ],
384 [ $::locale->text('Transaction description'), 'transaction_description' ],
390 sub _ap_transaction_list {
391 my ($self, $list, %params) = @_;
393 return $self->record_list(
395 title => $::locale->text('AP Transactions'),
396 type => 'ap_transaction',
398 [ $::locale->text('Invoice Date'), 'transdate' ],
399 [ $::locale->text('Invoice Number'), sub { $self->ap_transaction($_[0 ], display => 'table-cell') } ],
400 [ $::locale->text('Vendor'), 'vendor' ],
401 [ $::locale->text('Net amount'), 'netamount' ],
402 [ $::locale->text('Paid'), 'paid' ],
403 [ $::locale->text('Transaction description'), 'transaction_description' ],
409 sub _sepa_export_list {
410 my ($self, $list, %params) = @_;
412 my ($source, $destination) = $params{type} eq 'sepa_transfer' ? qw(our vc) : qw(vc our);
413 $params{title} = $params{type} eq 'sepa_transfer' ? $::locale->text('Bank transfers via SEPA') : $::locale->text('Bank collections via SEPA');
414 $params{with_columns} = [ grep { $_ ne 'record_link_direction' } @{ $params{with_columns} || [] } ];
416 delete $params{edit_record_links};
418 return $self->record_list(
421 [ $::locale->text('Export Number'), 'sepa_export', ],
422 [ $::locale->text('Execution date'), 'execution_date' ],
423 [ $::locale->text('Export date'), sub { $_[0]->sepa_export->itime->to_kivitendo } ],
424 [ $::locale->text('Source BIC'), "${source}_bic" ],
425 [ $::locale->text('Source IBAN'), "${source}_iban" ],
426 [ $::locale->text('Destination BIC'), "${destination}_bic" ],
427 [ $::locale->text('Destination IBAN'), "${destination}_iban" ],
428 [ $::locale->text('Amount'), 'amount' ],
434 sub _sepa_transfer_list {
435 my ($self, $list, %params) = @_;
436 _sepa_export_list($self, $list, %params, type => 'sepa_transfer');
439 sub _sepa_collection_list {
440 my ($self, $list, %params) = @_;
441 _sepa_export_list($self, $list, %params, type => 'sepa_collection');
454 SL::Presenter::Record - Presenter module for lists of
455 sales/purchase/general ledger record Rose::DB objects
459 # Retrieve a number of documents from somewhere, e.g.
460 my $order = SL::DB::Manager::Order->get_first(where => [ SL::DB::Manager::Order->type_filter('sales_order') ]);
461 my $records = $order->linked_records(destination => 'to');
463 # Give HTML representation:
464 my $html = SL::Presenter->get->grouped_record_list($records);
474 =item C<empty_record_list>
476 Returns a rendered version (actually an instance of
477 L<SL::Presenter::EscapedText>) of an empty list of records. Is usually
478 only called by L<grouped_record_list> if its list is empty.
480 =item C<grouped_record_list $list, %params>
482 Given a number of Rose::DB objects in the array reference C<$list>
483 this function first groups them by type. Then it calls L<record_list>
484 with each non-empty type-specific sub-list and the appropriate
485 parameters for outputting a list of those records.
487 Returns a rendered version (actually an instance of
488 L<SL::Presenter::EscapedText>) of all the lists.
490 The order in which the records are grouped is:
494 =item * sales quotations
498 =item * sales delivery orders
500 =item * sales invoices
502 =item * AR transactions
504 =item * requests for quotations
506 =item * purchase orders
508 =item * purchase delivery orders
510 =item * purchase invoices
512 =item * AP transactions
514 =item * SEPA collections
516 =item * SEPA transfers
520 Objects of unknown types are skipped.
522 Parameters are passed to C<record_list> include C<with_objects> and
523 C<edit_record_links>.
525 =item C<record_list $list, %params>
527 Returns a rendered version (actually an instance of
528 L<SL::Presenter::EscapedText>) of a list of records. This list
529 consists of a heading and a tabular representation of the list.
531 The parameters include:
537 Mandatory. The title to use in the heading. Must already be
542 Mandatory. An array reference of column specs to output. Each column
543 spec can be either an array reference or a hash reference.
545 If a column spec is an array reference then the first element is the
546 column's name shown in the table header. It must already be translated.
548 The second element can be either a string or a code reference. A
549 string is taken as the name of a function to call on the Rose::DB
550 object for the current row. Its return value is formatted depending on
551 the column's type (e.g. dates are output as the user expects them,
552 floating point numbers are rounded to two decimal places and
553 right-aligned etc). If it is a code reference then that code is called
554 with the object as the first argument. Its return value should be an
555 instance of L<SL::Presenter::EscapedText> and contain the rendered
556 representation of the content to output.
558 The third element, if present, can be a link to which the column will
561 If the column spec is a hash reference then the same arguments are
562 expected. The corresponding hash keys are C<title>, C<data> and
565 =item C<with_columns>
567 Can be set by the caller to indicate additional columns to
568 list. Currently supported:
572 =item C<record_link_destination>
574 The record link destination. Requires that the records to list have
575 been retrieved via the L<SL::DB::Helper::LinkedRecords> helper.
579 =item C<edit_record_links>
581 If trueish additional controls will be rendered that allow the user to
582 remove and add record links. Requires that the records to list have
583 been retrieved via the L<SL::DB::Helper::LinkedRecords> helper.
595 Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>