SL/Presenter/Record.pm

   1 package SL::Presenter::Record;
   2
   3 use strict;
   4
   5 use parent qw(Exporter);
   6
   7 use Exporter qw(import);
   8 our @EXPORT = qw(grouped_record_list empty_record_list record_list);
   9
  10 use Carp;
  11 use List::Util qw(first);
  12
  13 sub _arrayify {
  14   my ($array) = @_;
  15   return []     if !defined $array;
  16   return $array if ref $array;
  17   return [ $array ];
  18 }
  19
  20 sub grouped_record_list {
  21   my ($self, $list, %params) = @_;
  22
  23   %params    = map { exists $params{$_} ? ($_ => $params{$_}) : () } qw(edit_record_links with_columns object_id object_model);
  24
  25   my %groups = _sort_grouped_lists(_group_records($list));
  26   my $output = '';
  27
  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};
  33
  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};
  39
  40   $output  = $self->render('presenter/record/grouped_record_list', %params, output => $output);
  41
  42   return $output;
  43 }
  44
  45 sub empty_record_list {
  46   my ($self, %params) = @_;
  47   return $self->grouped_record_list([], %params);
  48 }
  49
  50 sub record_list {
  51   my ($self, $list, %params) = @_;
  52
  53   my @columns;
  54
  55   if (ref($params{columns}) eq 'ARRAY') {
  56     @columns = map {
  57       if (ref($_) eq 'ARRAY') {
  58         { title => $_->[0], data => $_->[1], link => $_->[2] }
  59       } else {
  60         $_;
  61       }
  62     } @{ delete $params{columns} };
  63
  64   } else {
  65     croak "Wrong type for 'columns' argument: not an array reference";
  66   }
  67
  68   my %with_columns = map { ($_ => 1) } @{ _arrayify($params{with_columns}) };
  69   if ($with_columns{record_link_direction}) {
  70     push @columns, {
  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') },
  73     };
  74   }
  75
  76   my %column_meta   = map { $_->name => $_ } @{ $list->[0]->meta->columns       };
  77   my %relationships = map { $_->name => $_ } @{ $list->[0]->meta->relationships };
  78
  79   my $call = sub {
  80     my ($obj, $method, @args) = @_;
  81     $obj->$method(@args);
  82   };
  83
  84   my @data;
  85   foreach my $obj (@{ $list }) {
  86     my @row;
  87
  88     foreach my $spec (@columns) {
  89       my %cell;
  90
  91       my $method       =  $spec->{column} || $spec->{data};
  92       my $meta         =  $column_meta{ $spec->{data} };
  93       my $type         =  ref $meta;
  94       my $relationship =  $relationships{ $spec->{data} };
  95       my $rel_type     =  !$relationship ? '' : lc $relationship->class;
  96       $rel_type        =~ s/^sl::db:://;
  97
  98       if (ref($spec->{data}) eq 'CODE') {
  99         $cell{value} = $spec->{data}->($obj);
 100
 101       } else {
 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);
 108       }
 109
 110       $cell{alignment} = 'right' if $type =~ m/int|serial|float|real|numeric/;
 111
 112       push @row, \%cell;
 113     }
 114
 115     push @data, { columns => \@row, record_link => $obj->{_record_link} };
 116   }
 117
 118   my @header =
 119     map +{ value     => $columns[$_]->{title},
 120            alignment => $data[0]->{columns}->[$_]->{alignment},
 121          }, (0..scalar(@columns) - 1);
 122
 123   return $self->render(
 124     'presenter/record/record_list',
 125     %params,
 126     TABLE_HEADER => \@header,
 127     TABLE_ROWS   => \@data,
 128   );
 129 }
 130
 131 #
 132 # private methods
 133 #
 134
 135 sub _group_records {
 136   my ($list) = @_;
 137
 138   my %matchers = (
 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                      },
 149   );
 150
 151   my %groups;
 152
 153   foreach my $record (@{ $list || [] }) {
 154     my $type         = (first { $matchers{$_}->($record) } keys %matchers) || 'other';
 155     $groups{$type} ||= [];
 156     push @{ $groups{$type} }, $record;
 157   }
 158
 159   return %groups;
 160 }
 161
 162 sub _sort_grouped_lists {
 163   my (%groups) = @_;
 164
 165   $groups{$_} = [ sort { $a->date <=> $b->date } @{ $groups{$_} } ] for keys %groups;
 166
 167   return %groups;
 168 }
 169
 170 sub _sales_quotation_list {
 171   my ($self, $list, %params) = @_;
 172
 173   return $self->record_list(
 174     $list,
 175     title   => $::locale->text('Sales Quotations'),
 176     type    => 'sales_quotation',
 177     columns => [
 178       [ $::locale->text('Quotation Date'),          'transdate'                                                                ],
 179       [ $::locale->text('Quotation Number'),        sub { $self->sales_quotation($_[0], display => 'table-cell') }   ],
 180       [ $::locale->text('Customer'),                'customer'                                                                 ],
 181       [ $::locale->text('Net amount'),              'netamount'                                                                ],
 182       [ $::locale->text('Transaction description'), 'transaction_description'                                                  ],
 183       [ $::locale->text('Project'),                 'globalproject', ],
 184       [ $::locale->text('Closed'),                  'closed'                                                                   ],
 185     ],
 186     %params,
 187   );
 188 }
 189
 190 sub _request_quotation_list {
 191   my ($self, $list, %params) = @_;
 192
 193   return $self->record_list(
 194     $list,
 195     title   => $::locale->text('Request Quotations'),
 196     type    => 'request_quotation',
 197     columns => [
 198       [ $::locale->text('Quotation Date'),          'transdate'                                                                ],
 199       [ $::locale->text('Quotation Number'),        sub { $self->request_quotation($_[0], display => 'table-cell') }   ],
 200       [ $::locale->text('Vendor'),                  'vendor'                                                                   ],
 201       [ $::locale->text('Net amount'),              'netamount'                                                                ],
 202       [ $::locale->text('Transaction description'), 'transaction_description'                                                  ],
 203       [ $::locale->text('Project'),                 'globalproject', ],
 204       [ $::locale->text('Closed'),                  'closed'                                                                   ],
 205     ],
 206     %params,
 207   );
 208 }
 209
 210 sub _sales_order_list {
 211   my ($self, $list, %params) = @_;
 212
 213   return $self->record_list(
 214     $list,
 215     title   => $::locale->text('Sales Orders'),
 216     type    => 'sales_order',
 217     columns => [
 218       [ $::locale->text('Order Date'),              'transdate'                                                                ],
 219       [ $::locale->text('Order Number'),            sub { $self->sales_order($_[0], display => 'table-cell') }   ],
 220       [ $::locale->text('Quotation'),               'quonumber' ],
 221       [ $::locale->text('Customer'),                'customer'                                                                 ],
 222       [ $::locale->text('Net amount'),              'netamount'                                                                ],
 223       [ $::locale->text('Transaction description'), 'transaction_description'                                                  ],
 224       [ $::locale->text('Project'),                 'globalproject', ],
 225       [ $::locale->text('Closed'),                  'closed'                                                                   ],
 226     ],
 227     %params,
 228   );
 229 }
 230
 231 sub _purchase_order_list {
 232   my ($self, $list, %params) = @_;
 233
 234   return $self->record_list(
 235     $list,
 236     title   => $::locale->text('Purchase Orders'),
 237     type    => 'purchase_order',
 238     columns => [
 239       [ $::locale->text('Order Date'),              'transdate'                                                                ],
 240       [ $::locale->text('Order Number'),            sub { $self->purchase_order($_[0], display => 'table-cell') }   ],
 241       [ $::locale->text('Request for Quotation'),   'quonumber' ],
 242       [ $::locale->text('Vendor'),                  'vendor'                                                                 ],
 243       [ $::locale->text('Net amount'),              'netamount'                                                                ],
 244       [ $::locale->text('Transaction description'), 'transaction_description'                                                  ],
 245       [ $::locale->text('Project'),                 'globalproject', ],
 246       [ $::locale->text('Closed'),                  'closed'                                                                   ],
 247     ],
 248     %params,
 249   );
 250 }
 251
 252 sub _sales_delivery_order_list {
 253   my ($self, $list, %params) = @_;
 254
 255   return $self->record_list(
 256     $list,
 257     title   => $::locale->text('Sales Delivery Orders'),
 258     type    => 'sales_delivery_order',
 259     columns => [
 260       [ $::locale->text('Delivery Order Date'),     'transdate'                                                                ],
 261       [ $::locale->text('Delivery Order Number'),   sub { $self->sales_delivery_order($_[0], display => 'table-cell') } ],
 262       [ $::locale->text('Order Number'),            'ordnumber' ],
 263       [ $::locale->text('Customer'),                'customer'                                                                 ],
 264       [ $::locale->text('Transaction description'), 'transaction_description'                                                  ],
 265       [ $::locale->text('Project'),                 'globalproject', ],
 266       [ $::locale->text('Delivered'),               'delivered'                                                                ],
 267       [ $::locale->text('Closed'),                  'closed'                                                                   ],
 268     ],
 269     %params,
 270   );
 271 }
 272
 273 sub _purchase_delivery_order_list {
 274   my ($self, $list, %params) = @_;
 275
 276   return $self->record_list(
 277     $list,
 278     title   => $::locale->text('Purchase Delivery Orders'),
 279     type    => 'purchase_delivery_order',
 280     columns => [
 281       [ $::locale->text('Delivery Order Date'),     'transdate'                                                                ],
 282       [ $::locale->text('Delivery Order Number'),   sub { $self->purchase_delivery_order($_[0], display => 'table-cell') } ],
 283       [ $::locale->text('Order Number'),            'ordnumber' ],
 284       [ $::locale->text('Vendor'),                  'vendor'                                                                 ],
 285       [ $::locale->text('Transaction description'), 'transaction_description'                                                  ],
 286       [ $::locale->text('Project'),                 'globalproject', ],
 287       [ $::locale->text('Delivered'),               'delivered'                                                                ],
 288       [ $::locale->text('Closed'),                  'closed'                                                                   ],
 289     ],
 290     %params,
 291   );
 292 }
 293
 294 sub _sales_invoice_list {
 295   my ($self, $list, %params) = @_;
 296
 297   return $self->record_list(
 298     $list,
 299     title   => $::locale->text('Sales Invoices'),
 300     type    => 'sales_invoice',
 301     columns => [
 302       [ $::locale->text('Invoice Date'),            'transdate'               ],
 303       [ $::locale->text('Invoice Number'),          sub { $self->sales_invoice($_[0], display => 'table-cell') } ],
 304       [ $::locale->text('Quotation Number'),        'quonumber' ],
 305       [ $::locale->text('Order Number'),            'ordnumber' ],
 306       [ $::locale->text('Customer'),                'customer'                ],
 307       [ $::locale->text('Net amount'),              'netamount'               ],
 308       [ $::locale->text('Paid'),                    'paid'                    ],
 309       [ $::locale->text('Transaction description'), 'transaction_description' ],
 310     ],
 311     %params,
 312   );
 313 }
 314
 315 sub _purchase_invoice_list {
 316   my ($self, $list, %params) = @_;
 317
 318   return $self->record_list(
 319     $list,
 320     title   => $::locale->text('Purchase Invoices'),
 321     type    => 'purchase_invoice',
 322     columns => [
 323       [ $::locale->text('Invoice Date'),                 'transdate'               ],
 324       [ $::locale->text('Invoice Number'),               sub { $self->purchase_invoice($_[0], display => 'table-cell') } ],
 325       [ $::locale->text('Request for Quotation Number'), 'quonumber' ],
 326       [ $::locale->text('Order Number'),                 'ordnumber' ],
 327       [ $::locale->text('Vendor'),                       'vendor'                 ],
 328       [ $::locale->text('Net amount'),                   'netamount'               ],
 329       [ $::locale->text('Paid'),                         'paid'                    ],
 330       [ $::locale->text('Transaction description'),      'transaction_description' ],
 331     ],
 332     %params,
 333   );
 334 }
 335
 336 sub _ar_transaction_list {
 337   my ($self, $list, %params) = @_;
 338
 339   return $self->record_list(
 340     $list,
 341     title   => $::locale->text('AR Transactions'),
 342     type    => 'ar_transaction',
 343     columns => [
 344       [ $::locale->text('Invoice Date'),            'transdate'               ],
 345       [ $::locale->text('Invoice Number'),          sub { $self->ar_transaction($_[0], display => 'table-cell') } ],
 346       [ $::locale->text('Customer'),                'customer'                ],
 347       [ $::locale->text('Net amount'),              'netamount'               ],
 348       [ $::locale->text('Paid'),                    'paid'                    ],
 349       [ $::locale->text('Transaction description'), 'transaction_description' ],
 350     ],
 351     %params,
 352   );
 353 }
 354
 355 sub _ap_transaction_list {
 356   my ($self, $list, %params) = @_;
 357
 358   return $self->record_list(
 359     $list,
 360     title   => $::locale->text('AP Transactions'),
 361     type    => 'ap_transaction',
 362     columns => [
 363       [ $::locale->text('Invoice Date'),            'transdate'                      ],
 364       [ $::locale->text('Invoice Number'),          sub { $self->ap_transaction($_[0 ], display => 'table-cell') } ],
 365       [ $::locale->text('Vendor'),                  'vendor'                         ],
 366       [ $::locale->text('Net amount'),              'netamount'                      ],
 367       [ $::locale->text('Paid'),                    'paid'                           ],
 368       [ $::locale->text('Transaction description'), 'transaction_description'        ],
 369     ],
 370     %params,
 371   );
 372 }
 373
 374 1;
 375
 376 __END__
 377
 378 =pod
 379
 380 =encoding utf8
 381
 382 =head1 NAME
 383
 384 SL::Presenter::Record - Presenter module for lists of
 385 sales/purchase/general ledger record Rose::DB objects
 386
 387 =head1 SYNOPSIS
 388
 389   # Retrieve a number of documents from somewhere, e.g.
 390   my $order   = SL::DB::Manager::Order->get_first(where => [ SL::DB::Manager::Order->type_filter('sales_order') ]);
 391   my $records = $order->linked_records(destination => 'to');
 392
 393   # Give HTML representation:
 394   my $html = SL::Presenter->get->grouped_record_list($records);
 395
 396 =head1 OVERVIEW
 397
 398 TODO
 399
 400 =head1 FUNCTIONS
 401
 402 =over 4
 403
 404 =item C<empty_record_list>
 405
 406 Returns a rendered version (actually an instance of
 407 L<SL::Presenter::EscapedText>) of an empty list of records. Is usually
 408 only called by L<grouped_record_list> if its list is empty.
 409
 410 =item C<grouped_record_list $list, %params>
 411
 412 Given a number of Rose::DB objects in the array reference C<$list>
 413 this function first groups them by type. Then it calls L<record_list>
 414 with each non-empty type-specific sub-list and the appropriate
 415 parameters for outputting a list of those records.
 416
 417 Returns a rendered version (actually an instance of
 418 L<SL::Presenter::EscapedText>) of all the lists.
 419
 420 The order in which the records are grouped is:
 421
 422 =over 2
 423
 424 =item * sales quotations
 425
 426 =item * sales orders
 427
 428 =item * sales delivery orders
 429
 430 =item * sales invoices
 431
 432 =item * AR transactions
 433
 434 =item * requests for quotations
 435
 436 =item * purchase orders
 437
 438 =item * purchase delivery orders
 439
 440 =item * purchase invoices
 441
 442 =item * AP transactions
 443
 444 =back
 445
 446 Objects of unknown types are skipped.
 447
 448 Parameters are passed to C<record_list> include C<with_objects> and
 449 C<edit_record_links>.
 450
 451 =item C<record_list $list, %params>
 452
 453 Returns a rendered version (actually an instance of
 454 L<SL::Presenter::EscapedText>) of a list of records. This list
 455 consists of a heading and a tabular representation of the list.
 456
 457 The parameters include:
 458
 459 =over 2
 460
 461 =item C<title>
 462
 463 Mandatory. The title to use in the heading. Must already be
 464 translated.
 465
 466 =item C<columns>
 467
 468 Mandatory. An array reference of column specs to output. Each column
 469 spec can be either an array reference or a hash reference.
 470
 471 If a column spec is an array reference then the first element is the
 472 column's name shown in the table header. It must already be translated.
 473
 474 The second element can be either a string or a code reference. A
 475 string is taken as the name of a function to call on the Rose::DB
 476 object for the current row. Its return value is formatted depending on
 477 the column's type (e.g. dates are output as the user expects them,
 478 floating point numbers are rounded to two decimal places and
 479 right-aligned etc). If it is a code reference then that code is called
 480 with the object as the first argument. Its return value should be an
 481 instance of L<SL::Presenter::EscapedText> and contain the rendered
 482 representation of the content to output.
 483
 484 The third element, if present, can be a link to which the column will
 485 be linked.
 486
 487 If the column spec is a hash reference then the same arguments are
 488 expected. The corresponding hash keys are C<title>, C<data> and
 489 C<link>.
 490
 491 =item C<with_columns>
 492
 493 Can be set by the caller to indicate additional columns to
 494 list. Currently supported:
 495
 496 =over 2
 497
 498 =item C<record_link_destination>
 499
 500 The record link destination. Requires that the records to list have
 501 been retrieved via the L<SL::DB::Helper::LinkedRecords> helper.
 502
 503 =back
 504
 505 =item C<edit_record_links>
 506
 507 If trueish additional controls will be rendered that allow the user to
 508 remove and add record links. Requires that the records to list have
 509 been retrieved via the L<SL::DB::Helper::LinkedRecords> helper.
 510
 511 =back
 512
 513 =back
 514
 515 =head1 BUGS
 516
 517 Nothing here yet.
 518
 519 =head1 AUTHOR
 520
 521 Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>
 522
 523 =cut