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 .= _sepa_collection_list( $self, $groups{sepa_collections}, %params) if $groups{sepa_collections};
59 $output .= _sepa_transfer_list( $self, $groups{sepa_transfers}, %params) if $groups{sepa_transfers};
61 $output = $self->render('presenter/record/grouped_record_list', %params, output => $output);
66 sub empty_record_list {
67 my ($self, %params) = @_;
68 return $self->grouped_record_list([], %params);
72 my ($self, $list, %params) = @_;
76 if (ref($params{columns}) eq 'ARRAY') {
78 if (ref($_) eq 'ARRAY') {
79 { title => $_->[0], data => $_->[1], link => $_->[2] }
83 } @{ delete $params{columns} };
86 croak "Wrong type for 'columns' argument: not an array reference";
89 my %with_columns = map { ($_ => 1) } @{ _arrayify($params{with_columns}) };
90 if ($with_columns{record_link_direction}) {
92 title => $::locale->text('Link direction'),
94 $_[0]->{_record_link_depth} > 1
95 ? $::locale->text('Row was linked to another record')
96 : $_[0]->{_record_link_direction} eq 'from'
97 ? $::locale->text('Row was source for current record')
98 : $::locale->text('Row was created from current record') },
102 my %column_meta = map { $_->name => $_ } @{ $list->[0]->meta->columns };
103 my %relationships = map { $_->name => $_ } @{ $list->[0]->meta->relationships };
106 my ($obj, $method, @args) = @_;
107 $obj->$method(@args);
111 foreach my $obj (@{ $list }) {
114 foreach my $spec (@columns) {
117 my $method = $spec->{column} || $spec->{data};
118 my $meta = $column_meta{ $spec->{data} };
119 my $type = ref $meta;
120 my $relationship = $relationships{ $spec->{data} };
121 my $rel_type = !$relationship ? '' : $relationship->class;
122 $rel_type =~ s/^SL::DB:://;
123 $rel_type = SL::Util::snakify($rel_type);
125 if (ref($spec->{data}) eq 'CODE') {
126 $cell{value} = $spec->{data}->($obj);
129 $cell{value} = $rel_type && $self->can($rel_type) ? $self->$rel_type($obj->$method, display => 'table-cell')
130 : $type eq 'Rose::DB::Object::Metadata::Column::Date' ? $call->($obj, $method . '_as_date')
131 : $type =~ m/^Rose::DB::Object::Metadata::Column::(?:Float|Numeric|Real)$/ ? $::form->format_amount(\%::myconfig, $call->($obj, $method), 2)
132 : $type eq 'Rose::DB::Object::Metadata::Column::Boolean' ? $call->($obj, $method . '_as_bool_yn')
133 : $type =~ m/^Rose::DB::Object::Metadata::Column::(?:Integer|Serial)$/ ? $spec->{data} * 1
134 : $call->($obj, $method);
137 $cell{alignment} = 'right' if $type =~ m/int|serial|float|real|numeric/;
142 push @data, { columns => \@row, record_link => $obj->{_record_link} };
146 map +{ value => $columns[$_]->{title},
147 alignment => $data[0]->{columns}->[$_]->{alignment},
148 }, (0..scalar(@columns) - 1);
150 return $self->render(
151 'presenter/record/record_list',
153 TABLE_HEADER => \@header,
154 TABLE_ROWS => \@data,
166 requirement_specs => sub { (ref($_[0]) eq 'SL::DB::RequirementSpec') },
167 sales_quotations => sub { (ref($_[0]) eq 'SL::DB::Order') && $_[0]->is_type('sales_quotation') },
168 sales_orders => sub { (ref($_[0]) eq 'SL::DB::Order') && $_[0]->is_type('sales_order') },
169 sales_delivery_orders => sub { (ref($_[0]) eq 'SL::DB::DeliveryOrder') && $_[0]->is_sales },
170 sales_invoices => sub { (ref($_[0]) eq 'SL::DB::Invoice') && $_[0]->invoice },
171 ar_transactions => sub { (ref($_[0]) eq 'SL::DB::Invoice') && !$_[0]->invoice },
172 purchase_quotations => sub { (ref($_[0]) eq 'SL::DB::Order') && $_[0]->is_type('request_quotation') },
173 purchase_orders => sub { (ref($_[0]) eq 'SL::DB::Order') && $_[0]->is_type('purchase_order') },
174 purchase_delivery_orders => sub { (ref($_[0]) eq 'SL::DB::DeliveryOrder') && !$_[0]->is_sales },
175 purchase_invoices => sub { (ref($_[0]) eq 'SL::DB::PurchaseInvoice') && $_[0]->invoice },
176 ap_transactions => sub { (ref($_[0]) eq 'SL::DB::PurchaseInvoice') && !$_[0]->invoice },
177 sepa_collections => sub { (ref($_[0]) eq 'SL::DB::SepaExportItem') && $_[0]->ar_id },
178 sepa_transfers => sub { (ref($_[0]) eq 'SL::DB::SepaExportItem') && $_[0]->ap_id },
179 gl_transactions => sub { (ref($_[0]) eq 'SL::DB::GLTransaction') },
184 foreach my $record (@{ $list || [] }) {
185 my $type = (first { $matchers{$_}->($record) } keys %matchers) || 'other';
186 $groups{$type} ||= [];
187 push @{ $groups{$type} }, $record;
193 sub _sort_grouped_lists {
196 foreach my $group (keys %groups) {
197 next unless @{ $groups{$group} };
198 if ($groups{$group}->[0]->can('compare_to')) {
199 $groups{$group} = [ sort { $a->compare_to($b) } @{ $groups{$group} } ];
201 $groups{$group} = [ sort { $a->date <=> $b->date } @{ $groups{$group} } ];
208 sub _requirement_spec_list {
209 my ($self, $list, %params) = @_;
211 return $self->record_list(
213 title => $::locale->text('Requirement specs'),
214 type => 'requirement_spec',
216 [ $::locale->text('Requirement spec number'), sub { $self->requirement_spec($_[0], display => 'table-cell') } ],
217 [ $::locale->text('Customer'), 'customer' ],
218 [ $::locale->text('Title'), 'title' ],
219 [ $::locale->text('Project'), 'project', ],
220 [ $::locale->text('Status'), sub { $_[0]->status->description } ],
226 sub _sales_quotation_list {
227 my ($self, $list, %params) = @_;
229 return $self->record_list(
231 title => $::locale->text('Sales Quotations'),
232 type => 'sales_quotation',
234 [ $::locale->text('Quotation Date'), 'transdate' ],
235 [ $::locale->text('Quotation Number'), sub { $self->sales_quotation($_[0], display => 'table-cell') } ],
236 [ $::locale->text('Customer'), 'customer' ],
237 [ $::locale->text('Net amount'), 'netamount' ],
238 [ $::locale->text('Transaction description'), 'transaction_description' ],
239 [ $::locale->text('Project'), 'globalproject', ],
240 [ $::locale->text('Closed'), 'closed' ],
246 sub _request_quotation_list {
247 my ($self, $list, %params) = @_;
249 return $self->record_list(
251 title => $::locale->text('Request Quotations'),
252 type => 'request_quotation',
254 [ $::locale->text('Quotation Date'), 'transdate' ],
255 [ $::locale->text('Quotation Number'), sub { $self->request_quotation($_[0], display => 'table-cell') } ],
256 [ $::locale->text('Vendor'), 'vendor' ],
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 _sales_order_list {
267 my ($self, $list, %params) = @_;
269 return $self->record_list(
271 title => $::locale->text('Sales Orders'),
272 type => 'sales_order',
274 [ $::locale->text('Order Date'), 'transdate' ],
275 [ $::locale->text('Order Number'), sub { $self->sales_order($_[0], display => 'table-cell') } ],
276 [ $::locale->text('Quotation'), 'quonumber' ],
277 [ $::locale->text('Customer'), 'customer' ],
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 _purchase_order_list {
288 my ($self, $list, %params) = @_;
290 return $self->record_list(
292 title => $::locale->text('Purchase Orders'),
293 type => 'purchase_order',
295 [ $::locale->text('Order Date'), 'transdate' ],
296 [ $::locale->text('Order Number'), sub { $self->purchase_order($_[0], display => 'table-cell') } ],
297 [ $::locale->text('Request for Quotation'), 'quonumber' ],
298 [ $::locale->text('Vendor'), 'vendor' ],
299 [ $::locale->text('Net amount'), 'netamount' ],
300 [ $::locale->text('Transaction description'), 'transaction_description' ],
301 [ $::locale->text('Project'), 'globalproject', ],
302 [ $::locale->text('Closed'), 'closed' ],
308 sub _sales_delivery_order_list {
309 my ($self, $list, %params) = @_;
311 return $self->record_list(
313 title => $::locale->text('Sales Delivery Orders'),
314 type => 'sales_delivery_order',
316 [ $::locale->text('Delivery Order Date'), 'transdate' ],
317 [ $::locale->text('Delivery Order Number'), sub { $self->sales_delivery_order($_[0], display => 'table-cell') } ],
318 [ $::locale->text('Order Number'), 'ordnumber' ],
319 [ $::locale->text('Customer'), 'customer' ],
320 [ $::locale->text('Transaction description'), 'transaction_description' ],
321 [ $::locale->text('Project'), 'globalproject', ],
322 [ $::locale->text('Delivered'), 'delivered' ],
323 [ $::locale->text('Closed'), 'closed' ],
329 sub _purchase_delivery_order_list {
330 my ($self, $list, %params) = @_;
332 return $self->record_list(
334 title => $::locale->text('Purchase Delivery Orders'),
335 type => 'purchase_delivery_order',
337 [ $::locale->text('Delivery Order Date'), 'transdate' ],
338 [ $::locale->text('Delivery Order Number'), sub { $self->purchase_delivery_order($_[0], display => 'table-cell') } ],
339 [ $::locale->text('Order Number'), 'ordnumber' ],
340 [ $::locale->text('Vendor'), 'vendor' ],
341 [ $::locale->text('Transaction description'), 'transaction_description' ],
342 [ $::locale->text('Project'), 'globalproject', ],
343 [ $::locale->text('Delivered'), 'delivered' ],
344 [ $::locale->text('Closed'), 'closed' ],
350 sub _sales_invoice_list {
351 my ($self, $list, %params) = @_;
353 return $self->record_list(
355 title => $::locale->text('Sales Invoices'),
356 type => 'sales_invoice',
358 [ $::locale->text('Invoice Date'), 'transdate' ],
359 [ $::locale->text('Type'), sub { $_[0]->displayable_type } ],
360 [ $::locale->text('Invoice Number'), sub { $self->sales_invoice($_[0], display => 'table-cell') } ],
361 [ $::locale->text('Quotation Number'), 'quonumber' ],
362 [ $::locale->text('Order Number'), 'ordnumber' ],
363 [ $::locale->text('Customer'), 'customer' ],
364 [ $::locale->text('Net amount'), 'netamount' ],
365 [ $::locale->text('Paid'), 'paid' ],
366 [ $::locale->text('Transaction description'), 'transaction_description' ],
372 sub _purchase_invoice_list {
373 my ($self, $list, %params) = @_;
375 return $self->record_list(
377 title => $::locale->text('Purchase Invoices'),
378 type => 'purchase_invoice',
380 [ $::locale->text('Invoice Date'), 'transdate' ],
381 [ $::locale->text('Invoice Number'), sub { $self->purchase_invoice($_[0], display => 'table-cell') } ],
382 [ $::locale->text('Request for Quotation Number'), 'quonumber' ],
383 [ $::locale->text('Order Number'), 'ordnumber' ],
384 [ $::locale->text('Vendor'), 'vendor' ],
385 [ $::locale->text('Net amount'), 'netamount' ],
386 [ $::locale->text('Paid'), 'paid' ],
387 [ $::locale->text('Transaction description'), 'transaction_description' ],
393 sub _ar_transaction_list {
394 my ($self, $list, %params) = @_;
396 return $self->record_list(
398 title => $::locale->text('AR Transactions'),
399 type => 'ar_transaction',
401 [ $::locale->text('Invoice Date'), 'transdate' ],
402 [ $::locale->text('Type'), sub { $_[0]->displayable_type } ],
403 [ $::locale->text('Invoice Number'), sub { $self->ar_transaction($_[0], display => 'table-cell') } ],
404 [ $::locale->text('Customer'), 'customer' ],
405 [ $::locale->text('Net amount'), 'netamount' ],
406 [ $::locale->text('Paid'), 'paid' ],
407 [ $::locale->text('Transaction description'), 'transaction_description' ],
413 sub _ap_transaction_list {
414 my ($self, $list, %params) = @_;
416 return $self->record_list(
418 title => $::locale->text('AP Transactions'),
419 type => 'ap_transaction',
421 [ $::locale->text('Invoice Date'), 'transdate' ],
422 [ $::locale->text('Invoice Number'), sub { $self->ap_transaction($_[0 ], display => 'table-cell') } ],
423 [ $::locale->text('Vendor'), 'vendor' ],
424 [ $::locale->text('Net amount'), 'netamount' ],
425 [ $::locale->text('Paid'), 'paid' ],
426 [ $::locale->text('Transaction description'), 'transaction_description' ],
432 sub _sepa_export_list {
433 my ($self, $list, %params) = @_;
435 my ($source, $destination) = $params{type} eq 'sepa_transfer' ? qw(our vc) : qw(vc our);
436 $params{title} = $params{type} eq 'sepa_transfer' ? $::locale->text('Bank transfers via SEPA') : $::locale->text('Bank collections via SEPA');
437 $params{with_columns} = [ grep { $_ ne 'record_link_direction' } @{ $params{with_columns} || [] } ];
439 delete $params{edit_record_links};
441 return $self->record_list(
444 [ $::locale->text('Export Number'), 'sepa_export', ],
445 [ $::locale->text('Execution date'), 'execution_date' ],
446 [ $::locale->text('Export date'), sub { $_[0]->sepa_export->itime->to_kivitendo } ],
447 [ $::locale->text('Source BIC'), "${source}_bic" ],
448 [ $::locale->text('Source IBAN'), "${source}_iban" ],
449 [ $::locale->text('Destination BIC'), "${destination}_bic" ],
450 [ $::locale->text('Destination IBAN'), "${destination}_iban" ],
451 [ $::locale->text('Amount'), 'amount' ],
457 sub _sepa_transfer_list {
458 my ($self, $list, %params) = @_;
459 _sepa_export_list($self, $list, %params, type => 'sepa_transfer');
462 sub _sepa_collection_list {
463 my ($self, $list, %params) = @_;
464 _sepa_export_list($self, $list, %params, type => 'sepa_collection');
477 SL::Presenter::Record - Presenter module for lists of
478 sales/purchase/general ledger record Rose::DB objects
482 # Retrieve a number of documents from somewhere, e.g.
483 my $order = SL::DB::Manager::Order->get_first(where => [ SL::DB::Manager::Order->type_filter('sales_order') ]);
484 my $records = $order->linked_records(destination => 'to');
486 # Give HTML representation:
487 my $html = SL::Presenter->get->grouped_record_list($records);
499 Returns a rendered version (actually an instance of
500 L<SL::Presenter::EscapedText>) of a single ar, ap or gl object.
503 # fetch the record from a random acc_trans object and print its link (could be ar, ap or gl)
504 my $record = SL::DB::Manager::AccTransaction->get_first()->record;
505 my $html = SL::Presenter->get->record($record, display => 'inline');
507 =item C<grouped_record_list $list, %params>
509 =item C<empty_record_list>
511 Returns a rendered version (actually an instance of
512 L<SL::Presenter::EscapedText>) of an empty list of records. Is usually
513 only called by L<grouped_record_list> if its list is empty.
515 =item C<grouped_record_list $list, %params>
517 Given a number of Rose::DB objects in the array reference C<$list>
518 this function first groups them by type. Then it calls L<record_list>
519 with each non-empty type-specific sub-list and the appropriate
520 parameters for outputting a list of those records.
522 Returns a rendered version (actually an instance of
523 L<SL::Presenter::EscapedText>) of all the lists.
525 The order in which the records are grouped is:
529 =item * sales quotations
533 =item * sales delivery orders
535 =item * sales invoices
537 =item * AR transactions
539 =item * requests for quotations
541 =item * purchase orders
543 =item * purchase delivery orders
545 =item * purchase invoices
547 =item * AP transactions
549 =item * SEPA collections
551 =item * SEPA transfers
555 Objects of unknown types are skipped.
557 Parameters are passed to C<record_list> include C<with_objects> and
558 C<edit_record_links>.
560 =item C<record_list $list, %params>
562 Returns a rendered version (actually an instance of
563 L<SL::Presenter::EscapedText>) of a list of records. This list
564 consists of a heading and a tabular representation of the list.
566 The parameters include:
572 Mandatory. The title to use in the heading. Must already be
577 Mandatory. An array reference of column specs to output. Each column
578 spec can be either an array reference or a hash reference.
580 If a column spec is an array reference then the first element is the
581 column's name shown in the table header. It must already be translated.
583 The second element can be either a string or a code reference. A
584 string is taken as the name of a function to call on the Rose::DB
585 object for the current row. Its return value is formatted depending on
586 the column's type (e.g. dates are output as the user expects them,
587 floating point numbers are rounded to two decimal places and
588 right-aligned etc). If it is a code reference then that code is called
589 with the object as the first argument. Its return value should be an
590 instance of L<SL::Presenter::EscapedText> and contain the rendered
591 representation of the content to output.
593 The third element, if present, can be a link to which the column will
596 If the column spec is a hash reference then the same arguments are
597 expected. The corresponding hash keys are C<title>, C<data> and
600 =item C<with_columns>
602 Can be set by the caller to indicate additional columns to
603 be listed. Currently supported:
607 =item C<record_link_destination>
609 The record link destination. Requires that the records to be listed have
610 been retrieved via the L<SL::DB::Helper::LinkedRecords> helper.
614 =item C<edit_record_links>
616 If trueish additional controls will be rendered that allow the user to
617 remove and add record links. Requires that the records to be listed have
618 been retrieved via the L<SL::DB::Helper::LinkedRecords> helper.
630 Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>