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'),
79 $_[0]->{_record_link_depth} > 1
80 ? $::locale->text('Row was linked to another record')
81 : $_[0]->{_record_link_direction} eq 'from'
82 ? $::locale->text('Row was source for current record')
83 : $::locale->text('Row was created from current record') },
87 my %column_meta = map { $_->name => $_ } @{ $list->[0]->meta->columns };
88 my %relationships = map { $_->name => $_ } @{ $list->[0]->meta->relationships };
91 my ($obj, $method, @args) = @_;
96 foreach my $obj (@{ $list }) {
99 foreach my $spec (@columns) {
102 my $method = $spec->{column} || $spec->{data};
103 my $meta = $column_meta{ $spec->{data} };
104 my $type = ref $meta;
105 my $relationship = $relationships{ $spec->{data} };
106 my $rel_type = !$relationship ? '' : $relationship->class;
107 $rel_type =~ s/^SL::DB:://;
108 $rel_type = SL::Util::snakify($rel_type);
110 if (ref($spec->{data}) eq 'CODE') {
111 $cell{value} = $spec->{data}->($obj);
114 $cell{value} = $rel_type && $self->can($rel_type) ? $self->$rel_type($obj->$method, display => 'table-cell')
115 : $type eq 'Rose::DB::Object::Metadata::Column::Date' ? $call->($obj, $method . '_as_date')
116 : $type =~ m/^Rose::DB::Object::Metadata::Column::(?:Float|Numeric|Real)$/ ? $::form->format_amount(\%::myconfig, $call->($obj, $method), 2)
117 : $type eq 'Rose::DB::Object::Metadata::Column::Boolean' ? $call->($obj, $method . '_as_bool_yn')
118 : $type =~ m/^Rose::DB::Object::Metadata::Column::(?:Integer|Serial)$/ ? $spec->{data} * 1
119 : $call->($obj, $method);
122 $cell{alignment} = 'right' if $type =~ m/int|serial|float|real|numeric/;
127 push @data, { columns => \@row, record_link => $obj->{_record_link} };
131 map +{ value => $columns[$_]->{title},
132 alignment => $data[0]->{columns}->[$_]->{alignment},
133 }, (0..scalar(@columns) - 1);
135 return $self->render(
136 'presenter/record/record_list',
138 TABLE_HEADER => \@header,
139 TABLE_ROWS => \@data,
151 requirement_specs => sub { (ref($_[0]) eq 'SL::DB::RequirementSpec') },
152 sales_quotations => sub { (ref($_[0]) eq 'SL::DB::Order') && $_[0]->is_type('sales_quotation') },
153 sales_orders => sub { (ref($_[0]) eq 'SL::DB::Order') && $_[0]->is_type('sales_order') },
154 sales_delivery_orders => sub { (ref($_[0]) eq 'SL::DB::DeliveryOrder') && $_[0]->is_sales },
155 sales_invoices => sub { (ref($_[0]) eq 'SL::DB::Invoice') && $_[0]->invoice },
156 ar_transactions => sub { (ref($_[0]) eq 'SL::DB::Invoice') && !$_[0]->invoice },
157 purchase_quotations => sub { (ref($_[0]) eq 'SL::DB::Order') && $_[0]->is_type('request_quotation') },
158 purchase_orders => sub { (ref($_[0]) eq 'SL::DB::Order') && $_[0]->is_type('purchase_order') },
159 purchase_delivery_orders => sub { (ref($_[0]) eq 'SL::DB::DeliveryOrder') && !$_[0]->is_sales },
160 purchase_invoices => sub { (ref($_[0]) eq 'SL::DB::PurchaseInvoice') && $_[0]->invoice },
161 ap_transactions => sub { (ref($_[0]) eq 'SL::DB::PurchaseInvoice') && !$_[0]->invoice },
162 sepa_collections => sub { (ref($_[0]) eq 'SL::DB::SepaExportItem') && $_[0]->ar_id },
163 sepa_transfers => sub { (ref($_[0]) eq 'SL::DB::SepaExportItem') && $_[0]->ap_id },
168 foreach my $record (@{ $list || [] }) {
169 my $type = (first { $matchers{$_}->($record) } keys %matchers) || 'other';
170 $groups{$type} ||= [];
171 push @{ $groups{$type} }, $record;
177 sub _sort_grouped_lists {
180 foreach my $group (keys %groups) {
181 next unless @{ $groups{$group} };
182 if ($groups{$group}->[0]->can('compare_to')) {
183 $groups{$group} = [ sort { $a->compare_to($b) } @{ $groups{$group} } ];
185 $groups{$group} = [ sort { $a->date <=> $b->date } @{ $groups{$group} } ];
192 sub _requirement_spec_list {
193 my ($self, $list, %params) = @_;
195 return $self->record_list(
197 title => $::locale->text('Requirement specs'),
198 type => 'requirement_spec',
200 [ $::locale->text('Requirement spec number'), sub { $self->requirement_spec($_[0], display => 'table-cell') } ],
201 [ $::locale->text('Customer'), 'customer' ],
202 [ $::locale->text('Title'), 'title' ],
203 [ $::locale->text('Project'), 'project', ],
204 [ $::locale->text('Status'), sub { $_[0]->status->description } ],
210 sub _sales_quotation_list {
211 my ($self, $list, %params) = @_;
213 return $self->record_list(
215 title => $::locale->text('Sales Quotations'),
216 type => 'sales_quotation',
218 [ $::locale->text('Quotation Date'), 'transdate' ],
219 [ $::locale->text('Quotation Number'), sub { $self->sales_quotation($_[0], display => 'table-cell') } ],
220 [ $::locale->text('Customer'), 'customer' ],
221 [ $::locale->text('Net amount'), 'netamount' ],
222 [ $::locale->text('Transaction description'), 'transaction_description' ],
223 [ $::locale->text('Project'), 'globalproject', ],
224 [ $::locale->text('Closed'), 'closed' ],
230 sub _request_quotation_list {
231 my ($self, $list, %params) = @_;
233 return $self->record_list(
235 title => $::locale->text('Request Quotations'),
236 type => 'request_quotation',
238 [ $::locale->text('Quotation Date'), 'transdate' ],
239 [ $::locale->text('Quotation Number'), sub { $self->request_quotation($_[0], display => 'table-cell') } ],
240 [ $::locale->text('Vendor'), 'vendor' ],
241 [ $::locale->text('Net amount'), 'netamount' ],
242 [ $::locale->text('Transaction description'), 'transaction_description' ],
243 [ $::locale->text('Project'), 'globalproject', ],
244 [ $::locale->text('Closed'), 'closed' ],
250 sub _sales_order_list {
251 my ($self, $list, %params) = @_;
253 return $self->record_list(
255 title => $::locale->text('Sales Orders'),
256 type => 'sales_order',
258 [ $::locale->text('Order Date'), 'transdate' ],
259 [ $::locale->text('Order Number'), sub { $self->sales_order($_[0], display => 'table-cell') } ],
260 [ $::locale->text('Quotation'), 'quonumber' ],
261 [ $::locale->text('Customer'), 'customer' ],
262 [ $::locale->text('Net amount'), 'netamount' ],
263 [ $::locale->text('Transaction description'), 'transaction_description' ],
264 [ $::locale->text('Project'), 'globalproject', ],
265 [ $::locale->text('Closed'), 'closed' ],
271 sub _purchase_order_list {
272 my ($self, $list, %params) = @_;
274 return $self->record_list(
276 title => $::locale->text('Purchase Orders'),
277 type => 'purchase_order',
279 [ $::locale->text('Order Date'), 'transdate' ],
280 [ $::locale->text('Order Number'), sub { $self->purchase_order($_[0], display => 'table-cell') } ],
281 [ $::locale->text('Request for Quotation'), 'quonumber' ],
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_delivery_order_list {
293 my ($self, $list, %params) = @_;
295 return $self->record_list(
297 title => $::locale->text('Sales Delivery Orders'),
298 type => 'sales_delivery_order',
300 [ $::locale->text('Delivery Order Date'), 'transdate' ],
301 [ $::locale->text('Delivery Order Number'), sub { $self->sales_delivery_order($_[0], display => 'table-cell') } ],
302 [ $::locale->text('Order Number'), 'ordnumber' ],
303 [ $::locale->text('Customer'), 'customer' ],
304 [ $::locale->text('Transaction description'), 'transaction_description' ],
305 [ $::locale->text('Project'), 'globalproject', ],
306 [ $::locale->text('Delivered'), 'delivered' ],
307 [ $::locale->text('Closed'), 'closed' ],
313 sub _purchase_delivery_order_list {
314 my ($self, $list, %params) = @_;
316 return $self->record_list(
318 title => $::locale->text('Purchase Delivery Orders'),
319 type => 'purchase_delivery_order',
321 [ $::locale->text('Delivery Order Date'), 'transdate' ],
322 [ $::locale->text('Delivery Order Number'), sub { $self->purchase_delivery_order($_[0], display => 'table-cell') } ],
323 [ $::locale->text('Order Number'), 'ordnumber' ],
324 [ $::locale->text('Vendor'), 'vendor' ],
325 [ $::locale->text('Transaction description'), 'transaction_description' ],
326 [ $::locale->text('Project'), 'globalproject', ],
327 [ $::locale->text('Delivered'), 'delivered' ],
328 [ $::locale->text('Closed'), 'closed' ],
334 sub _sales_invoice_list {
335 my ($self, $list, %params) = @_;
337 return $self->record_list(
339 title => $::locale->text('Sales Invoices'),
340 type => 'sales_invoice',
342 [ $::locale->text('Invoice Date'), 'transdate' ],
343 [ $::locale->text('Type'), sub { $_[0]->displayable_type } ],
344 [ $::locale->text('Invoice Number'), sub { $self->sales_invoice($_[0], display => 'table-cell') } ],
345 [ $::locale->text('Quotation Number'), 'quonumber' ],
346 [ $::locale->text('Order Number'), 'ordnumber' ],
347 [ $::locale->text('Customer'), 'customer' ],
348 [ $::locale->text('Net amount'), 'netamount' ],
349 [ $::locale->text('Paid'), 'paid' ],
350 [ $::locale->text('Transaction description'), 'transaction_description' ],
356 sub _purchase_invoice_list {
357 my ($self, $list, %params) = @_;
359 return $self->record_list(
361 title => $::locale->text('Purchase Invoices'),
362 type => 'purchase_invoice',
364 [ $::locale->text('Invoice Date'), 'transdate' ],
365 [ $::locale->text('Invoice Number'), sub { $self->purchase_invoice($_[0], display => 'table-cell') } ],
366 [ $::locale->text('Request for Quotation Number'), 'quonumber' ],
367 [ $::locale->text('Order Number'), 'ordnumber' ],
368 [ $::locale->text('Vendor'), 'vendor' ],
369 [ $::locale->text('Net amount'), 'netamount' ],
370 [ $::locale->text('Paid'), 'paid' ],
371 [ $::locale->text('Transaction description'), 'transaction_description' ],
377 sub _ar_transaction_list {
378 my ($self, $list, %params) = @_;
380 return $self->record_list(
382 title => $::locale->text('AR Transactions'),
383 type => 'ar_transaction',
385 [ $::locale->text('Invoice Date'), 'transdate' ],
386 [ $::locale->text('Type'), sub { $_[0]->displayable_type } ],
387 [ $::locale->text('Invoice Number'), sub { $self->ar_transaction($_[0], display => 'table-cell') } ],
388 [ $::locale->text('Customer'), 'customer' ],
389 [ $::locale->text('Net amount'), 'netamount' ],
390 [ $::locale->text('Paid'), 'paid' ],
391 [ $::locale->text('Transaction description'), 'transaction_description' ],
397 sub _ap_transaction_list {
398 my ($self, $list, %params) = @_;
400 return $self->record_list(
402 title => $::locale->text('AP Transactions'),
403 type => 'ap_transaction',
405 [ $::locale->text('Invoice Date'), 'transdate' ],
406 [ $::locale->text('Invoice Number'), sub { $self->ap_transaction($_[0 ], display => 'table-cell') } ],
407 [ $::locale->text('Vendor'), 'vendor' ],
408 [ $::locale->text('Net amount'), 'netamount' ],
409 [ $::locale->text('Paid'), 'paid' ],
410 [ $::locale->text('Transaction description'), 'transaction_description' ],
416 sub _sepa_export_list {
417 my ($self, $list, %params) = @_;
419 my ($source, $destination) = $params{type} eq 'sepa_transfer' ? qw(our vc) : qw(vc our);
420 $params{title} = $params{type} eq 'sepa_transfer' ? $::locale->text('Bank transfers via SEPA') : $::locale->text('Bank collections via SEPA');
421 $params{with_columns} = [ grep { $_ ne 'record_link_direction' } @{ $params{with_columns} || [] } ];
423 delete $params{edit_record_links};
425 return $self->record_list(
428 [ $::locale->text('Export Number'), 'sepa_export', ],
429 [ $::locale->text('Execution date'), 'execution_date' ],
430 [ $::locale->text('Export date'), sub { $_[0]->sepa_export->itime->to_kivitendo } ],
431 [ $::locale->text('Source BIC'), "${source}_bic" ],
432 [ $::locale->text('Source IBAN'), "${source}_iban" ],
433 [ $::locale->text('Destination BIC'), "${destination}_bic" ],
434 [ $::locale->text('Destination IBAN'), "${destination}_iban" ],
435 [ $::locale->text('Amount'), 'amount' ],
441 sub _sepa_transfer_list {
442 my ($self, $list, %params) = @_;
443 _sepa_export_list($self, $list, %params, type => 'sepa_transfer');
446 sub _sepa_collection_list {
447 my ($self, $list, %params) = @_;
448 _sepa_export_list($self, $list, %params, type => 'sepa_collection');
461 SL::Presenter::Record - Presenter module for lists of
462 sales/purchase/general ledger record Rose::DB objects
466 # Retrieve a number of documents from somewhere, e.g.
467 my $order = SL::DB::Manager::Order->get_first(where => [ SL::DB::Manager::Order->type_filter('sales_order') ]);
468 my $records = $order->linked_records(destination => 'to');
470 # Give HTML representation:
471 my $html = SL::Presenter->get->grouped_record_list($records);
481 =item C<empty_record_list>
483 Returns a rendered version (actually an instance of
484 L<SL::Presenter::EscapedText>) of an empty list of records. Is usually
485 only called by L<grouped_record_list> if its list is empty.
487 =item C<grouped_record_list $list, %params>
489 Given a number of Rose::DB objects in the array reference C<$list>
490 this function first groups them by type. Then it calls L<record_list>
491 with each non-empty type-specific sub-list and the appropriate
492 parameters for outputting a list of those records.
494 Returns a rendered version (actually an instance of
495 L<SL::Presenter::EscapedText>) of all the lists.
497 The order in which the records are grouped is:
501 =item * sales quotations
505 =item * sales delivery orders
507 =item * sales invoices
509 =item * AR transactions
511 =item * requests for quotations
513 =item * purchase orders
515 =item * purchase delivery orders
517 =item * purchase invoices
519 =item * AP transactions
521 =item * SEPA collections
523 =item * SEPA transfers
527 Objects of unknown types are skipped.
529 Parameters are passed to C<record_list> include C<with_objects> and
530 C<edit_record_links>.
532 =item C<record_list $list, %params>
534 Returns a rendered version (actually an instance of
535 L<SL::Presenter::EscapedText>) of a list of records. This list
536 consists of a heading and a tabular representation of the list.
538 The parameters include:
544 Mandatory. The title to use in the heading. Must already be
549 Mandatory. An array reference of column specs to output. Each column
550 spec can be either an array reference or a hash reference.
552 If a column spec is an array reference then the first element is the
553 column's name shown in the table header. It must already be translated.
555 The second element can be either a string or a code reference. A
556 string is taken as the name of a function to call on the Rose::DB
557 object for the current row. Its return value is formatted depending on
558 the column's type (e.g. dates are output as the user expects them,
559 floating point numbers are rounded to two decimal places and
560 right-aligned etc). If it is a code reference then that code is called
561 with the object as the first argument. Its return value should be an
562 instance of L<SL::Presenter::EscapedText> and contain the rendered
563 representation of the content to output.
565 The third element, if present, can be a link to which the column will
568 If the column spec is a hash reference then the same arguments are
569 expected. The corresponding hash keys are C<title>, C<data> and
572 =item C<with_columns>
574 Can be set by the caller to indicate additional columns to
575 be listed. Currently supported:
579 =item C<record_link_destination>
581 The record link destination. Requires that the records to be listed have
582 been retrieved via the L<SL::DB::Helper::LinkedRecords> helper.
586 =item C<edit_record_links>
588 If trueish additional controls will be rendered that allow the user to
589 remove and add record links. Requires that the records to be listed have
590 been retrieved via the L<SL::DB::Helper::LinkedRecords> helper.
602 Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>