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);
11 use List::Util qw(first);
15 return [] if !defined $array;
16 return $array if ref $array;
20 sub grouped_record_list {
21 my ($self, $list, %params) = @_;
23 %params = map { exists $params{$_} ? ($_ => $params{$_}) : () } qw(edit_record_links with_columns object_id object_model);
25 my %groups = _group_records($list);
28 $output .= _sales_quotation_list( $self, $groups{sales_quotations}, %params) if $groups{sales_quotations};
29 $output .= _sales_order_list( $self, $groups{sales_orders}, %params) if $groups{sales_orders};
30 $output .= _sales_delivery_order_list( $self, $groups{sales_delivery_orders}, %params) if $groups{sales_delivery_orders};
31 $output .= _sales_invoice_list( $self, $groups{sales_invoices}, %params) if $groups{sales_invoices};
32 $output .= _ar_transaction_list( $self, $groups{ar_transactions}, %params) if $groups{ar_transactions};
34 $output .= _request_quotation_list( $self, $groups{purchase_quotations}, %params) if $groups{purchase_quotations};
35 $output .= _purchase_order_list( $self, $groups{purchase_orders}, %params) if $groups{purchase_orders};
36 $output .= _purchase_delivery_order_list($self, $groups{purchase_delivery_orders}, %params) if $groups{purchase_delivery_orders};
37 $output .= _purchase_invoice_list( $self, $groups{purchase_invoices}, %params) if $groups{purchase_invoices};
38 $output .= _ar_transaction_list( $self, $groups{ar_transactions}, %params) if $groups{ar_transactions};
40 $output = $self->render('presenter/record/grouped_record_list', %params, output => $output);
45 sub empty_record_list {
46 my ($self, %params) = @_;
47 return $self->grouped_record_list([], %params);
51 my ($self, $list, %params) = @_;
55 if (ref($params{columns}) eq 'ARRAY') {
57 if (ref($_) eq 'ARRAY') {
58 { title => $_->[0], data => $_->[1], link => $_->[2] }
62 } @{ delete $params{columns} };
65 croak "Wrong type for 'columns' argument: not an array reference";
68 my %with_columns = map { ($_ => 1) } @{ _arrayify($params{with_columns}) };
69 if ($with_columns{record_link_direction}) {
71 title => $::locale->text('Link direction'),
72 data => sub { $_[0]->{_record_link_direction} eq 'from' ? $::locale->text('Row was source for current record') : $::locale->text('Row was created from current record') },
76 my %column_meta = map { $_->name => $_ } @{ $list->[0]->meta->columns };
77 my %relationships = map { $_->name => $_ } @{ $list->[0]->meta->relationships };
80 my ($obj, $method, @args) = @_;
85 foreach my $obj (@{ $list }) {
88 foreach my $spec (@columns) {
91 my $method = $spec->{column} || $spec->{data};
92 my $meta = $column_meta{ $spec->{data} };
94 my $relationship = $relationships{ $spec->{data} };
95 my $rel_type = !$relationship ? '' : lc $relationship->class;
96 $rel_type =~ s/^sl::db:://;
98 if (ref($spec->{data}) eq 'CODE') {
99 $cell{value} = $spec->{data}->($obj);
102 $cell{value} = $rel_type && $self->can($rel_type) ? $self->$rel_type($obj->$method, display => 'table-cell')
103 : $type eq 'Rose::DB::Object::Metadata::Column::Date' ? $call->($obj, $method . '_as_date')
104 : $type =~ m/^Rose::DB::Object::Metadata::Column::(?:Float|Numeric|Real)$/ ? $::form->format_amount(\%::myconfig, $call->($obj, $method), 2)
105 : $type eq 'Rose::DB::Object::Metadata::Column::Boolean' ? $call->($obj, $method . '_as_bool_yn')
106 : $type =~ m/^Rose::DB::Object::Metadata::Column::(?:Integer|Serial)$/ ? $spec->{data} * 1
107 : $call->($obj, $method);
110 $cell{alignment} = 'right' if $type =~ m/int|serial|float|real|numeric/;
115 push @data, { columns => \@row, record_link => $obj->{_record_link} };
119 map +{ value => $columns[$_]->{title},
120 alignment => $data[0]->{columns}->[$_]->{alignment},
121 }, (0..scalar(@columns) - 1);
123 return $self->render(
124 'presenter/record/record_list',
126 TABLE_HEADER => \@header,
127 TABLE_ROWS => \@data,
139 sales_quotations => sub { (ref($_[0]) eq 'SL::DB::Order') && $_[0]->is_type('sales_quotation') },
140 sales_orders => sub { (ref($_[0]) eq 'SL::DB::Order') && $_[0]->is_type('sales_order') },
141 sales_delivery_orders => sub { (ref($_[0]) eq 'SL::DB::DeliveryOrder') && $_[0]->is_sales },
142 sales_invoices => sub { (ref($_[0]) eq 'SL::DB::Invoice') && $_[0]->invoice },
143 ar_transactions => sub { (ref($_[0]) eq 'SL::DB::Invoice') && !$_[0]->invoice },
144 purchase_quotations => sub { (ref($_[0]) eq 'SL::DB::Order') && $_[0]->is_type('request_quotation') },
145 purchase_orders => sub { (ref($_[0]) eq 'SL::DB::Order') && $_[0]->is_type('purchase_order') },
146 purchase_delivery_orders => sub { (ref($_[0]) eq 'SL::DB::DeliveryOrder') && !$_[0]->is_sales },
147 purchase_invoices => sub { (ref($_[0]) eq 'SL::DB::PurchaseInvoice') && $_[0]->invoice },
148 ap_transactions => sub { (ref($_[0]) eq 'SL::DB::PurchaseInvoice') && !$_[0]->invoice },
153 foreach my $record (@{ $list || [] }) {
154 my $type = (first { $matchers{$_}->($record) } keys %matchers) || 'other';
155 $groups{$type} ||= [];
156 push @{ $groups{$type} }, $record;
162 sub _sales_quotation_list {
163 my ($self, $list, %params) = @_;
165 return $self->record_list(
167 title => $::locale->text('Sales Quotations'),
168 type => 'sales_quotation',
170 [ $::locale->text('Quotation Date'), 'transdate' ],
171 [ $::locale->text('Quotation Number'), sub { $self->sales_quotation($_[0], display => 'table-cell') } ],
172 [ $::locale->text('Customer'), 'customer' ],
173 [ $::locale->text('Net amount'), 'netamount' ],
174 [ $::locale->text('Transaction description'), 'transaction_description' ],
175 [ $::locale->text('Project'), 'globalproject', ],
176 [ $::locale->text('Closed'), 'closed' ],
182 sub _request_quotation_list {
183 my ($self, $list, %params) = @_;
185 return $self->record_list(
187 title => $::locale->text('Request Quotations'),
188 type => 'request_quotation',
190 [ $::locale->text('Quotation Date'), 'transdate' ],
191 [ $::locale->text('Quotation Number'), sub { $self->request_quotation($_[0], display => 'table-cell') } ],
192 [ $::locale->text('Vendor'), 'vendor' ],
193 [ $::locale->text('Net amount'), 'netamount' ],
194 [ $::locale->text('Transaction description'), 'transaction_description' ],
195 [ $::locale->text('Project'), 'globalproject', ],
196 [ $::locale->text('Closed'), 'closed' ],
202 sub _sales_order_list {
203 my ($self, $list, %params) = @_;
205 return $self->record_list(
207 title => $::locale->text('Sales Orders'),
208 type => 'sales_order',
210 [ $::locale->text('Order Date'), 'transdate' ],
211 [ $::locale->text('Order Number'), sub { $self->sales_order($_[0], display => 'table-cell') } ],
212 [ $::locale->text('Quotation'), 'quonumber' ],
213 [ $::locale->text('Customer'), 'customer' ],
214 [ $::locale->text('Net amount'), 'netamount' ],
215 [ $::locale->text('Transaction description'), 'transaction_description' ],
216 [ $::locale->text('Project'), 'globalproject', ],
217 [ $::locale->text('Closed'), 'closed' ],
223 sub _purchase_order_list {
224 my ($self, $list, %params) = @_;
226 return $self->record_list(
228 title => $::locale->text('Purchase Orders'),
229 type => 'purchase_order',
231 [ $::locale->text('Order Date'), 'transdate' ],
232 [ $::locale->text('Order Number'), sub { $self->purchase_order($_[0], display => 'table-cell') } ],
233 [ $::locale->text('Request for Quotation'), 'quonumber' ],
234 [ $::locale->text('Vendor'), 'vendor' ],
235 [ $::locale->text('Net amount'), 'netamount' ],
236 [ $::locale->text('Transaction description'), 'transaction_description' ],
237 [ $::locale->text('Project'), 'globalproject', ],
238 [ $::locale->text('Closed'), 'closed' ],
244 sub _sales_delivery_order_list {
245 my ($self, $list, %params) = @_;
247 return $self->record_list(
249 title => $::locale->text('Sales Delivery Orders'),
250 type => 'sales_delivery_order',
252 [ $::locale->text('Delivery Order Date'), 'transdate' ],
253 [ $::locale->text('Delivery Order Number'), sub { $self->sales_delivery_order($_[0], display => 'table-cell') } ],
254 [ $::locale->text('Order Number'), 'ordnumber' ],
255 [ $::locale->text('Customer'), 'customer' ],
256 [ $::locale->text('Transaction description'), 'transaction_description' ],
257 [ $::locale->text('Project'), 'globalproject', ],
258 [ $::locale->text('Delivered'), 'delivered' ],
259 [ $::locale->text('Closed'), 'closed' ],
265 sub _purchase_delivery_order_list {
266 my ($self, $list, %params) = @_;
268 return $self->record_list(
270 title => $::locale->text('Purchase Delivery Orders'),
271 type => 'purchase_delivery_order',
273 [ $::locale->text('Delivery Order Date'), 'transdate' ],
274 [ $::locale->text('Delivery Order Number'), sub { $self->purchase_delivery_order($_[0], display => 'table-cell') } ],
275 [ $::locale->text('Order Number'), 'ordnumber' ],
276 [ $::locale->text('Vendor'), 'vendor' ],
277 [ $::locale->text('Transaction description'), 'transaction_description' ],
278 [ $::locale->text('Project'), 'globalproject', ],
279 [ $::locale->text('Delivered'), 'delivered' ],
280 [ $::locale->text('Closed'), 'closed' ],
286 sub _sales_invoice_list {
287 my ($self, $list, %params) = @_;
289 return $self->record_list(
291 title => $::locale->text('Sales Invoices'),
292 type => 'sales_invoice',
294 [ $::locale->text('Invoice Date'), 'transdate' ],
295 [ $::locale->text('Invoice Number'), sub { $self->sales_invoice($_[0], display => 'table-cell') } ],
296 [ $::locale->text('Quotation Number'), 'quonumber' ],
297 [ $::locale->text('Order Number'), 'ordnumber' ],
298 [ $::locale->text('Customer'), 'customer' ],
299 [ $::locale->text('Net amount'), 'netamount' ],
300 [ $::locale->text('Paid'), 'paid' ],
301 [ $::locale->text('Transaction description'), 'transaction_description' ],
307 sub _purchase_invoice_list {
308 my ($self, $list, %params) = @_;
310 return $self->record_list(
312 title => $::locale->text('Purchase Invoices'),
313 type => 'purchase_invoice',
315 [ $::locale->text('Invoice Date'), 'transdate' ],
316 [ $::locale->text('Invoice Number'), sub { $self->purchase_invoice($_[0], display => 'table-cell') } ],
317 [ $::locale->text('Request for Quotation Number'), 'quonumber' ],
318 [ $::locale->text('Order Number'), 'ordnumber' ],
319 [ $::locale->text('Vendor'), 'vendor' ],
320 [ $::locale->text('Net amount'), 'netamount' ],
321 [ $::locale->text('Paid'), 'paid' ],
322 [ $::locale->text('Transaction description'), 'transaction_description' ],
328 sub _ar_transaction_list {
329 my ($self, $list, %params) = @_;
331 return $self->record_list(
333 title => $::locale->text('AR Transactions'),
334 type => 'ar_transaction',
336 [ $::locale->text('Invoice Date'), 'transdate' ],
337 [ $::locale->text('Invoice Number'), sub { $self->ar_transaction($_[0], display => 'table-cell') } ],
338 [ $::locale->text('Customer'), 'customer' ],
339 [ $::locale->text('Net amount'), 'netamount' ],
340 [ $::locale->text('Paid'), 'paid' ],
341 [ $::locale->text('Transaction description'), 'transaction_description' ],
347 sub _ap_transaction_list {
348 my ($self, $list, %params) = @_;
350 return $self->record_list(
352 title => $::locale->text('AP Transactions'),
353 type => 'ap_transaction',
355 [ $::locale->text('Invoice Date'), 'transdate' ],
356 [ $::locale->text('Invoice Number'), sub { $self->ap_transaction($_[0 ], display => 'table-cell') } ],
357 [ $::locale->text('Vendor'), 'vendor' ],
358 [ $::locale->text('Net amount'), 'netamount' ],
359 [ $::locale->text('Paid'), 'paid' ],
360 [ $::locale->text('Transaction description'), 'transaction_description' ],
376 SL::Presenter::Record - Presenter module for lists of
377 sales/purchase/general ledger record Rose::DB objects
381 # Retrieve a number of documents from somewhere, e.g.
382 my $order = SL::DB::Manager::Order->get_first(where => [ SL::DB::Manager::Order->type_filter('sales_order') ]);
383 my $records = $order->linked_records(destination => 'to');
385 # Give HTML representation:
386 my $html = SL::Presenter->get->grouped_record_list($records);
396 =item C<empty_record_list>
398 Returns a rendered version (actually an instance of
399 L<SL::Presenter::EscapedText>) of an empty list of records. Is usually
400 only called by L<grouped_record_list> if its list is empty.
402 =item C<grouped_record_list $list, %params>
404 Given a number of Rose::DB objects in the array reference C<$list>
405 this function first groups them by type. Then it calls L<record_list>
406 with each non-empty type-specific sub-list and the appropriate
407 parameters for outputting a list of those records.
409 Returns a rendered version (actually an instance of
410 L<SL::Presenter::EscapedText>) of all the lists.
412 The order in which the records are grouped is:
416 =item * sales quotations
420 =item * sales delivery orders
422 =item * sales invoices
424 =item * AR transactions
426 =item * requests for quotations
428 =item * purchase orders
430 =item * purchase delivery orders
432 =item * purchase invoices
434 =item * AP transactions
438 Objects of unknown types are skipped.
440 Parameters are passed to C<record_list> include C<with_objects> and
441 C<edit_record_links>.
443 =item C<record_list $list, %params>
445 Returns a rendered version (actually an instance of
446 L<SL::Presenter::EscapedText>) of a list of records. This list
447 consists of a heading and a tabular representation of the list.
449 The parameters include:
455 Mandatory. The title to use in the heading. Must already be
460 Mandatory. An array reference of column specs to output. Each column
461 spec can be either an array reference or a hash reference.
463 If a column spec is an array reference then the first element is the
464 column's name shown in the table header. It must already be translated.
466 The second element can be either a string or a code reference. A
467 string is taken as the name of a function to call on the Rose::DB
468 object for the current row. Its return value is formatted depending on
469 the column's type (e.g. dates are output as the user expects them,
470 floating point numbers are rounded to two decimal places and
471 right-aligned etc). If it is a code reference then that code is called
472 with the object as the first argument. Its return value should be an
473 instance of L<SL::Presenter::EscapedText> and contain the rendered
474 representation of the content to output.
476 The third element, if present, can be a link to which the column will
479 If the column spec is a hash reference then the same arguments are
480 expected. The corresponding hash keys are C<title>, C<data> and
483 =item C<with_columns>
485 Can be set by the caller to indicate additional columns to
486 list. Currently supported:
490 =item C<record_link_destination>
492 The record link destination. Requires that the records to list have
493 been retrieved via the L<SL::DB::Helper::LinkedRecords> helper.
497 =item C<edit_record_links>
499 If trueish additional controls will be rendered that allow the user to
500 remove and add record links. Requires that the records to list have
501 been retrieved via the L<SL::DB::Helper::LinkedRecords> helper.
513 Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>