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 = _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 _sales_quotation_list {
 163   my ($self, $list, %params) = @_;
 164
 165   return $self->record_list(
 166     $list,
 167     title   => $::locale->text('Sales Quotations'),
 168     type    => 'sales_quotation',
 169     columns => [
 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'                                                                   ],
 177     ],
 178     %params,
 179   );
 180 }
 181
 182 sub _request_quotation_list {
 183   my ($self, $list, %params) = @_;
 184
 185   return $self->record_list(
 186     $list,
 187     title   => $::locale->text('Request Quotations'),
 188     type    => 'request_quotation',
 189     columns => [
 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'                                                                   ],
 197     ],
 198     %params,
 199   );
 200 }
 201
 202 sub _sales_order_list {
 203   my ($self, $list, %params) = @_;
 204
 205   return $self->record_list(
 206     $list,
 207     title   => $::locale->text('Sales Orders'),
 208     type    => 'sales_order',
 209     columns => [
 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'                                                                   ],
 218     ],
 219     %params,
 220   );
 221 }
 222
 223 sub _purchase_order_list {
 224   my ($self, $list, %params) = @_;
 225
 226   return $self->record_list(
 227     $list,
 228     title   => $::locale->text('Purchase Orders'),
 229     type    => 'purchase_order',
 230     columns => [
 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'                                                                   ],
 239     ],
 240     %params,
 241   );
 242 }
 243
 244 sub _sales_delivery_order_list {
 245   my ($self, $list, %params) = @_;
 246
 247   return $self->record_list(
 248     $list,
 249     title   => $::locale->text('Sales Delivery Orders'),
 250     type    => 'sales_delivery_order',
 251     columns => [
 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'                                                                   ],
 260     ],
 261     %params,
 262   );
 263 }
 264
 265 sub _purchase_delivery_order_list {
 266   my ($self, $list, %params) = @_;
 267
 268   return $self->record_list(
 269     $list,
 270     title   => $::locale->text('Purchase Delivery Orders'),
 271     type    => 'purchase_delivery_order',
 272     columns => [
 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'                                                                   ],
 281     ],
 282     %params,
 283   );
 284 }
 285
 286 sub _sales_invoice_list {
 287   my ($self, $list, %params) = @_;
 288
 289   return $self->record_list(
 290     $list,
 291     title   => $::locale->text('Sales Invoices'),
 292     type    => 'sales_invoice',
 293     columns => [
 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' ],
 302     ],
 303     %params,
 304   );
 305 }
 306
 307 sub _purchase_invoice_list {
 308   my ($self, $list, %params) = @_;
 309
 310   return $self->record_list(
 311     $list,
 312     title   => $::locale->text('Purchase Invoices'),
 313     type    => 'purchase_invoice',
 314     columns => [
 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' ],
 323     ],
 324     %params,
 325   );
 326 }
 327
 328 sub _ar_transaction_list {
 329   my ($self, $list, %params) = @_;
 330
 331   return $self->record_list(
 332     $list,
 333     title   => $::locale->text('AR Transactions'),
 334     type    => 'ar_transaction',
 335     columns => [
 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' ],
 342     ],
 343     %params,
 344   );
 345 }
 346
 347 sub _ap_transaction_list {
 348   my ($self, $list, %params) = @_;
 349
 350   return $self->record_list(
 351     $list,
 352     title   => $::locale->text('AP Transactions'),
 353     type    => 'ap_transaction',
 354     columns => [
 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'        ],
 361     ],
 362     %params,
 363   );
 364 }
 365
 366 1;
 367
 368 __END__
 369
 370 =pod
 371
 372 =encoding utf8
 373
 374 =head1 NAME
 375
 376 SL::Presenter::Record - Presenter module for lists of
 377 sales/purchase/general ledger record Rose::DB objects
 378
 379 =head1 SYNOPSIS
 380
 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');
 384
 385   # Give HTML representation:
 386   my $html = SL::Presenter->get->grouped_record_list($records);
 387
 388 =head1 OVERVIEW
 389
 390 TODO
 391
 392 =head1 FUNCTIONS
 393
 394 =over 4
 395
 396 =item C<empty_record_list>
 397
 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.
 401
 402 =item C<grouped_record_list $list, %params>
 403
 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.
 408
 409 Returns a rendered version (actually an instance of
 410 L<SL::Presenter::EscapedText>) of all the lists.
 411
 412 The order in which the records are grouped is:
 413
 414 =over 2
 415
 416 =item * sales quotations
 417
 418 =item * sales orders
 419
 420 =item * sales delivery orders
 421
 422 =item * sales invoices
 423
 424 =item * AR transactions
 425
 426 =item * requests for quotations
 427
 428 =item * purchase orders
 429
 430 =item * purchase delivery orders
 431
 432 =item * purchase invoices
 433
 434 =item * AP transactions
 435
 436 =back
 437
 438 Objects of unknown types are skipped.
 439
 440 Parameters are passed to C<record_list> include C<with_objects> and
 441 C<edit_record_links>.
 442
 443 =item C<record_list $list, %params>
 444
 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.
 448
 449 The parameters include:
 450
 451 =over 2
 452
 453 =item C<title>
 454
 455 Mandatory. The title to use in the heading. Must already be
 456 translated.
 457
 458 =item C<columns>
 459
 460 Mandatory. An array reference of column specs to output. Each column
 461 spec can be either an array reference or a hash reference.
 462
 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.
 465
 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.
 475
 476 The third element, if present, can be a link to which the column will
 477 be linked.
 478
 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
 481 C<link>.
 482
 483 =item C<with_columns>
 484
 485 Can be set by the caller to indicate additional columns to
 486 list. Currently supported:
 487
 488 =over 2
 489
 490 =item C<record_link_destination>
 491
 492 The record link destination. Requires that the records to list have
 493 been retrieved via the L<SL::DB::Helper::LinkedRecords> helper.
 494
 495 =back
 496
 497 =item C<edit_record_links>
 498
 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.
 502
 503 =back
 504
 505 =back
 506
 507 =head1 BUGS
 508
 509 Nothing here yet.
 510
 511 =head1 AUTHOR
 512
 513 Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>
 514
 515 =cut