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('Invoice Number'), sub { $self->sales_invoice($_[0], display => 'table-cell') } ],
344 [ $::locale->text('Quotation Number'), 'quonumber' ],
345 [ $::locale->text('Order Number'), 'ordnumber' ],
346 [ $::locale->text('Customer'), 'customer' ],
347 [ $::locale->text('Net amount'), 'netamount' ],
348 [ $::locale->text('Paid'), 'paid' ],
349 [ $::locale->text('Transaction description'), 'transaction_description' ],
355 sub _purchase_invoice_list {
356 my ($self, $list, %params) = @_;
358 return $self->record_list(
360 title => $::locale->text('Purchase Invoices'),
361 type => 'purchase_invoice',
363 [ $::locale->text('Invoice Date'), 'transdate' ],
364 [ $::locale->text('Invoice Number'), sub { $self->purchase_invoice($_[0], display => 'table-cell') } ],
365 [ $::locale->text('Request for Quotation Number'), 'quonumber' ],
366 [ $::locale->text('Order Number'), 'ordnumber' ],
367 [ $::locale->text('Vendor'), 'vendor' ],
368 [ $::locale->text('Net amount'), 'netamount' ],
369 [ $::locale->text('Paid'), 'paid' ],
370 [ $::locale->text('Transaction description'), 'transaction_description' ],
376 sub _ar_transaction_list {
377 my ($self, $list, %params) = @_;
379 return $self->record_list(
381 title => $::locale->text('AR Transactions'),
382 type => 'ar_transaction',
384 [ $::locale->text('Invoice Date'), 'transdate' ],
385 [ $::locale->text('Invoice Number'), sub { $self->ar_transaction($_[0], display => 'table-cell') } ],
386 [ $::locale->text('Customer'), 'customer' ],
387 [ $::locale->text('Net amount'), 'netamount' ],
388 [ $::locale->text('Paid'), 'paid' ],
389 [ $::locale->text('Transaction description'), 'transaction_description' ],
395 sub _ap_transaction_list {
396 my ($self, $list, %params) = @_;
398 return $self->record_list(
400 title => $::locale->text('AP Transactions'),
401 type => 'ap_transaction',
403 [ $::locale->text('Invoice Date'), 'transdate' ],
404 [ $::locale->text('Invoice Number'), sub { $self->ap_transaction($_[0 ], display => 'table-cell') } ],
405 [ $::locale->text('Vendor'), 'vendor' ],
406 [ $::locale->text('Net amount'), 'netamount' ],
407 [ $::locale->text('Paid'), 'paid' ],
408 [ $::locale->text('Transaction description'), 'transaction_description' ],
414 sub _sepa_export_list {
415 my ($self, $list, %params) = @_;
417 my ($source, $destination) = $params{type} eq 'sepa_transfer' ? qw(our vc) : qw(vc our);
418 $params{title} = $params{type} eq 'sepa_transfer' ? $::locale->text('Bank transfers via SEPA') : $::locale->text('Bank collections via SEPA');
419 $params{with_columns} = [ grep { $_ ne 'record_link_direction' } @{ $params{with_columns} || [] } ];
421 delete $params{edit_record_links};
423 return $self->record_list(
426 [ $::locale->text('Export Number'), 'sepa_export', ],
427 [ $::locale->text('Execution date'), 'execution_date' ],
428 [ $::locale->text('Export date'), sub { $_[0]->sepa_export->itime->to_kivitendo } ],
429 [ $::locale->text('Source BIC'), "${source}_bic" ],
430 [ $::locale->text('Source IBAN'), "${source}_iban" ],
431 [ $::locale->text('Destination BIC'), "${destination}_bic" ],
432 [ $::locale->text('Destination IBAN'), "${destination}_iban" ],
433 [ $::locale->text('Amount'), 'amount' ],
439 sub _sepa_transfer_list {
440 my ($self, $list, %params) = @_;
441 _sepa_export_list($self, $list, %params, type => 'sepa_transfer');
444 sub _sepa_collection_list {
445 my ($self, $list, %params) = @_;
446 _sepa_export_list($self, $list, %params, type => 'sepa_collection');
459 SL::Presenter::Record - Presenter module for lists of
460 sales/purchase/general ledger record Rose::DB objects
464 # Retrieve a number of documents from somewhere, e.g.
465 my $order = SL::DB::Manager::Order->get_first(where => [ SL::DB::Manager::Order->type_filter('sales_order') ]);
466 my $records = $order->linked_records(destination => 'to');
468 # Give HTML representation:
469 my $html = SL::Presenter->get->grouped_record_list($records);
479 =item C<empty_record_list>
481 Returns a rendered version (actually an instance of
482 L<SL::Presenter::EscapedText>) of an empty list of records. Is usually
483 only called by L<grouped_record_list> if its list is empty.
485 =item C<grouped_record_list $list, %params>
487 Given a number of Rose::DB objects in the array reference C<$list>
488 this function first groups them by type. Then it calls L<record_list>
489 with each non-empty type-specific sub-list and the appropriate
490 parameters for outputting a list of those records.
492 Returns a rendered version (actually an instance of
493 L<SL::Presenter::EscapedText>) of all the lists.
495 The order in which the records are grouped is:
499 =item * sales quotations
503 =item * sales delivery orders
505 =item * sales invoices
507 =item * AR transactions
509 =item * requests for quotations
511 =item * purchase orders
513 =item * purchase delivery orders
515 =item * purchase invoices
517 =item * AP transactions
519 =item * SEPA collections
521 =item * SEPA transfers
525 Objects of unknown types are skipped.
527 Parameters are passed to C<record_list> include C<with_objects> and
528 C<edit_record_links>.
530 =item C<record_list $list, %params>
532 Returns a rendered version (actually an instance of
533 L<SL::Presenter::EscapedText>) of a list of records. This list
534 consists of a heading and a tabular representation of the list.
536 The parameters include:
542 Mandatory. The title to use in the heading. Must already be
547 Mandatory. An array reference of column specs to output. Each column
548 spec can be either an array reference or a hash reference.
550 If a column spec is an array reference then the first element is the
551 column's name shown in the table header. It must already be translated.
553 The second element can be either a string or a code reference. A
554 string is taken as the name of a function to call on the Rose::DB
555 object for the current row. Its return value is formatted depending on
556 the column's type (e.g. dates are output as the user expects them,
557 floating point numbers are rounded to two decimal places and
558 right-aligned etc). If it is a code reference then that code is called
559 with the object as the first argument. Its return value should be an
560 instance of L<SL::Presenter::EscapedText> and contain the rendered
561 representation of the content to output.
563 The third element, if present, can be a link to which the column will
566 If the column spec is a hash reference then the same arguments are
567 expected. The corresponding hash keys are C<title>, C<data> and
570 =item C<with_columns>
572 Can be set by the caller to indicate additional columns to
573 list. Currently supported:
577 =item C<record_link_destination>
579 The record link destination. Requires that the records to list have
580 been retrieved via the L<SL::DB::Helper::LinkedRecords> helper.
584 =item C<edit_record_links>
586 If trueish additional controls will be rendered that allow the user to
587 remove and add record links. Requires that the records to list have
588 been retrieved via the L<SL::DB::Helper::LinkedRecords> helper.
600 Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>