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 grouped_record_list {
  14   my ($self, $list, %params) = @_;
  15
  16   my %groups = _group_records($list);
  17   my $output = '';
  18
  19   $output .= _sales_quotation_list(        $self, $groups{sales_quotations})         if $groups{sales_quotations};
  20   $output .= _sales_order_list(            $self, $groups{sales_orders})             if $groups{sales_orders};
  21   $output .= _sales_delivery_order_list(   $self, $groups{sales_delivery_orders})    if $groups{sales_delivery_orders};
  22   $output .= _sales_invoice_list(          $self, $groups{sales_invoices})           if $groups{sales_invoices};
  23   $output .= _ar_transaction_list(         $self, $groups{ar_transactions})          if $groups{ar_transactions};
  24
  25   $output .= _request_quotation_list(      $self, $groups{purchase_quotations})      if $groups{purchase_quotations};
  26   $output .= _purchase_order_list(         $self, $groups{purchase_orders})          if $groups{purchase_orders};
  27   $output .= _purchase_delivery_order_list($self, $groups{purchase_delivery_orders}) if $groups{purchase_delivery_orders};
  28   $output .= _purchase_invoice_list(       $self, $groups{purchase_invoices})        if $groups{purchase_invoices};
  29   $output .= _ar_transaction_list(         $self, $groups{ar_transactions})          if $groups{ar_transactions};
  30
  31   return $output || $self->empty_record_list;
  32 }
  33
  34 sub empty_record_list {
  35   my ($self) = @_;
  36   return $self->render('presenter/record/empty_record_list');
  37 }
  38
  39 sub record_list {
  40   my ($self, $list, %params) = @_;
  41
  42   my @columns;
  43
  44   if (ref($params{columns}) eq 'ARRAY') {
  45     @columns = map {
  46       if (ref($_) eq 'ARRAY') {
  47         { title => $_->[0], data => $_->[1], link => $_->[2] }
  48       } else {
  49         $_;
  50       }
  51     } @{ delete $params{columns} };
  52
  53   } else {
  54     croak "Wrong type for 'columns' argument: not an array reference";
  55   }
  56
  57   my %column_meta   = map { $_->name => $_ } @{ $list->[0]->meta->columns       };
  58   my %relationships = map { $_->name => $_ } @{ $list->[0]->meta->relationships };
  59
  60   my $call = sub {
  61     my ($obj, $method, @args) = @_;
  62     $obj->$method(@args);
  63   };
  64
  65   my @data;
  66   foreach my $obj (@{ $list }) {
  67     my @row;
  68
  69     foreach my $spec (@columns) {
  70       my %cell;
  71
  72       my $method       =  $spec->{column} || $spec->{data};
  73       my $meta         =  $column_meta{ $spec->{data} };
  74       my $type         =  ref $meta;
  75       my $relationship =  $relationships{ $spec->{data} };
  76       my $rel_type     =  !$relationship ? '' : lc $relationship->class;
  77       $rel_type        =~ s/^sl::db:://;
  78
  79       if (ref($spec->{data}) eq 'CODE') {
  80         $cell{value} = $spec->{data}->($obj);
  81
  82       } else {
  83         $cell{value} = $rel_type && $self->can($rel_type)                                       ? $self->$rel_type($obj->$method, display => 'table-cell')
  84                      : $type eq 'Rose::DB::Object::Metadata::Column::Date'                      ? $call->($obj, $method . '_as_date')
  85                      : $type =~ m/^Rose::DB::Object::Metadata::Column::(?:Float|Numeric|Real)$/ ? $::form->format_amount(\%::myconfig, $call->($obj, $method), 2)
  86                      : $type eq 'Rose::DB::Object::Metadata::Column::Boolean'                   ? $call->($obj, $method . '_as_bool_yn')
  87                      : $type =~ m/^Rose::DB::Object::Metadata::Column::(?:Integer|Serial)$/     ? $spec->{data} * 1
  88                      :                                                                            $call->($obj, $method);
  89       }
  90
  91       $cell{alignment} = 'right' if $type =~ m/int|serial|float|real|numeric/;
  92
  93       push @row, \%cell;
  94     }
  95
  96     push @data, \@row;
  97   }
  98
  99   my @header =
 100     map +{ value     => $columns[$_]->{title},
 101            alignment => $data[0]->[$_]->{alignment},
 102          }, (0..scalar(@columns) - 1);
 103
 104   return $self->render(
 105     'presenter/record/record_list',
 106     %params,
 107     TABLE_HEADER => \@header,
 108     TABLE_ROWS   => \@data,
 109   );
 110 }
 111
 112 #
 113 # private methods
 114 #
 115
 116 sub _group_records {
 117   my ($list) = @_;
 118
 119   my %matchers = (
 120     sales_quotations         => sub { (ref($_[0]) eq 'SL::DB::Order')           &&  $_[0]->is_type('sales_quotation')   },
 121     sales_orders             => sub { (ref($_[0]) eq 'SL::DB::Order')           &&  $_[0]->is_type('sales_order')       },
 122     sales_delivery_orders    => sub { (ref($_[0]) eq 'SL::DB::DeliveryOrder')   &&  $_[0]->is_sales                     },
 123     sales_invoices           => sub { (ref($_[0]) eq 'SL::DB::Invoice')         &&  $_[0]->invoice                      },
 124     ar_transactions          => sub { (ref($_[0]) eq 'SL::DB::Invoice')         && !$_[0]->invoice                      },
 125     purchase_quotations      => sub { (ref($_[0]) eq 'SL::DB::Order')           &&  $_[0]->is_type('request_quotation') },
 126     purchase_orders          => sub { (ref($_[0]) eq 'SL::DB::Order')           &&  $_[0]->is_type('purchase_order')    },
 127     purchase_delivery_orders => sub { (ref($_[0]) eq 'SL::DB::DeliveryOrder')   && !$_[0]->is_sales                     },
 128     purchase_invoices        => sub { (ref($_[0]) eq 'SL::DB::PurchaseInvoice') &&  $_[0]->invoice                      },
 129     ap_transactions          => sub { (ref($_[0]) eq 'SL::DB::PurchaseInvoice') && !$_[0]->invoice                      },
 130   );
 131
 132   my %groups;
 133
 134   foreach my $record (@{ $list || [] }) {
 135     my $type         = (first { $matchers{$_}->($record) } keys %matchers) || 'other';
 136     $groups{$type} ||= [];
 137     push @{ $groups{$type} }, $record;
 138   }
 139
 140   return %groups;
 141 }
 142
 143 sub _sales_quotation_list {
 144   my ($self, $list) = @_;
 145
 146   return $self->record_list(
 147     $list,
 148     title   => $::locale->text('Sales Quotations'),
 149     columns => [
 150       [ $::locale->text('Quotation Date'),          'transdate'                                                                ],
 151       [ $::locale->text('Quotation Number'),        sub { $self->sales_quotation($_[0], display => 'table-cell') }   ],
 152       [ $::locale->text('Customer'),                'customer'                                                                 ],
 153       [ $::locale->text('Net amount'),              'netamount'                                                                ],
 154       [ $::locale->text('Transaction description'), 'transaction_description'                                                  ],
 155       [ $::locale->text('Project'),                 'globalproject', ],
 156       [ $::locale->text('Closed'),                  'closed'                                                                   ],
 157     ],
 158   );
 159 }
 160
 161 sub _request_quotation_list {
 162   my ($self, $list) = @_;
 163
 164   return $self->record_list(
 165     $list,
 166     title   => $::locale->text('Request Quotations'),
 167     columns => [
 168       [ $::locale->text('Quotation Date'),          'transdate'                                                                ],
 169       [ $::locale->text('Quotation Number'),        sub { $self->sales_quotation($_[0], display => 'table-cell') }   ],
 170       [ $::locale->text('Vendor'),                  'vendor'                                                                   ],
 171       [ $::locale->text('Net amount'),              'netamount'                                                                ],
 172       [ $::locale->text('Transaction description'), 'transaction_description'                                                  ],
 173       [ $::locale->text('Project'),                 'globalproject', ],
 174       [ $::locale->text('Closed'),                  'closed'                                                                   ],
 175     ],
 176   );
 177 }
 178
 179 sub _sales_order_list {
 180   my ($self, $list) = @_;
 181
 182   return $self->record_list(
 183     $list,
 184     title   => $::locale->text('Sales Orders'),
 185     columns => [
 186       [ $::locale->text('Order Date'),              'transdate'                                                                ],
 187       [ $::locale->text('Order Number'),            sub { $self->sales_order($_[0], display => 'table-cell') }   ],
 188       [ $::locale->text('Quotation'),               'quonumber' ],
 189       [ $::locale->text('Customer'),                'customer'                                                                 ],
 190       [ $::locale->text('Net amount'),              'netamount'                                                                ],
 191       [ $::locale->text('Transaction description'), 'transaction_description'                                                  ],
 192       [ $::locale->text('Project'),                 'globalproject', ],
 193       [ $::locale->text('Closed'),                  'closed'                                                                   ],
 194     ],
 195   );
 196 }
 197
 198 sub _purchase_order_list {
 199   my ($self, $list) = @_;
 200
 201   return $self->record_list(
 202     $list,
 203     title   => $::locale->text('Purchase Orders'),
 204     columns => [
 205       [ $::locale->text('Order Date'),              'transdate'                                                                ],
 206       [ $::locale->text('Order Number'),            sub { $self->sales_order($_[0], display => 'table-cell') }   ],
 207       [ $::locale->text('Request for Quotation'),   'quonumber' ],
 208       [ $::locale->text('Vendor'),                  'vendor'                                                                 ],
 209       [ $::locale->text('Net amount'),              'netamount'                                                                ],
 210       [ $::locale->text('Transaction description'), 'transaction_description'                                                  ],
 211       [ $::locale->text('Project'),                 'globalproject', ],
 212       [ $::locale->text('Closed'),                  'closed'                                                                   ],
 213     ],
 214   );
 215 }
 216
 217 sub _sales_delivery_order_list {
 218   my ($self, $list) = @_;
 219
 220   return $self->record_list(
 221     $list,
 222     title   => $::locale->text('Sales Delivery Orders'),
 223     columns => [
 224       [ $::locale->text('Delivery Order Date'),     'transdate'                                                                ],
 225       [ $::locale->text('Delivery Order Number'),   sub { $self->sales_delivery_order($_[0], display => 'table-cell') } ],
 226       [ $::locale->text('Order Number'),            'ordnumber' ],
 227       [ $::locale->text('Customer'),                'customer'                                                                 ],
 228       [ $::locale->text('Transaction description'), 'transaction_description'                                                  ],
 229       [ $::locale->text('Project'),                 'globalproject', ],
 230       [ $::locale->text('Delivered'),               'delivered'                                                                ],
 231       [ $::locale->text('Closed'),                  'closed'                                                                   ],
 232     ],
 233   );
 234 }
 235
 236 sub _purchase_delivery_order_list {
 237   my ($self, $list) = @_;
 238
 239   return $self->record_list(
 240     $list,
 241     title   => $::locale->text('Purchase Delivery Orders'),
 242     columns => [
 243       [ $::locale->text('Delivery Order Date'),     'transdate'                                                                ],
 244       [ $::locale->text('Delivery Order Number'),   sub { $self->sales_delivery_order($_[0], display => 'table-cell') } ],
 245       [ $::locale->text('Order Number'),            'ordnumber' ],
 246       [ $::locale->text('Vendor'),                  'vendor'                                                                 ],
 247       [ $::locale->text('Transaction description'), 'transaction_description'                                                  ],
 248       [ $::locale->text('Project'),                 'globalproject', ],
 249       [ $::locale->text('Delivered'),               'delivered'                                                                ],
 250       [ $::locale->text('Closed'),                  'closed'                                                                   ],
 251     ],
 252   );
 253 }
 254
 255 sub _sales_invoice_list {
 256   my ($self, $list) = @_;
 257
 258   return $self->record_list(
 259     $list,
 260     title   => $::locale->text('Sales Invoices'),
 261     columns => [
 262       [ $::locale->text('Invoice Date'),            'transdate'               ],
 263       [ $::locale->text('Invoice Number'),          sub { $self->sales_invoice($_[0], display => 'table-cell') } ],
 264       [ $::locale->text('Quotation Number'),        'quonumber' ],
 265       [ $::locale->text('Order Number'),            'ordnumber' ],
 266       [ $::locale->text('Customer'),                'customer'                ],
 267       [ $::locale->text('Net amount'),              'netamount'               ],
 268       [ $::locale->text('Paid'),                    'paid'                    ],
 269       [ $::locale->text('Transaction description'), 'transaction_description' ],
 270     ],
 271   );
 272 }
 273
 274 sub _purchase_invoice_list {
 275   my ($self, $list) = @_;
 276
 277   return $self->record_list(
 278     $list,
 279     title   => $::locale->text('Purchase Invoices'),
 280     columns => [
 281       [ $::locale->text('Invoice Date'),                 'transdate'               ],
 282       [ $::locale->text('Invoice Number'),               sub { $self->sales_invoice($_[0], display => 'table-cell') } ],
 283       [ $::locale->text('Request for Quotation Number'), 'quonumber' ],
 284       [ $::locale->text('Order Number'),                 'ordnumber' ],
 285       [ $::locale->text('Vendor'),                       'vendor'                 ],
 286       [ $::locale->text('Net amount'),                   'netamount'               ],
 287       [ $::locale->text('Paid'),                         'paid'                    ],
 288       [ $::locale->text('Transaction description'),      'transaction_description' ],
 289     ],
 290   );
 291 }
 292
 293 sub _ar_transaction_list {
 294   my ($self, $list) = @_;
 295
 296   return $self->record_list(
 297     $list,
 298     title   => $::locale->text('AR Transactions'),
 299     columns => [
 300       [ $::locale->text('Invoice Date'),            'transdate'               ],
 301       [ $::locale->text('Invoice Number'),          sub { $self->ar_transaction($_[0], display => 'table-cell') } ],
 302       [ $::locale->text('Customer'),                'customer'                ],
 303       [ $::locale->text('Net amount'),              'netamount'               ],
 304       [ $::locale->text('Paid'),                    'paid'                    ],
 305       [ $::locale->text('Transaction description'), 'transaction_description' ],
 306     ],
 307   );
 308 }
 309
 310 sub _ap_transaction_list {
 311   my ($self, $list) = @_;
 312
 313   return $self->record_list(
 314     $list,
 315     title   => $::locale->text('AP Transactions'),
 316     columns => [
 317       [ $::locale->text('Invoice Date'),            'transdate'                      ],
 318       [ $::locale->text('Invoice Number'),          sub { $self->ar_transaction($_[0 ], display => 'table-cell') } ],
 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   );
 325 }
 326
 327 1;
 328
 329 __END__
 330
 331 =pod
 332
 333 =encoding utf8
 334
 335 =head1 NAME
 336
 337 SL::Presenter::Record - Presenter module for lists of
 338 sales/purchase/general ledger record Rose::DB objects
 339
 340 =head1 SYNOPSIS
 341
 342   # Retrieve a number of documents from somewhere, e.g.
 343   my $order   = SL::DB::Manager::Order->get_first(where => [ SL::DB::Manager::Order->type_filter('sales_order') ]);
 344   my $records = $order->linked_records(destination => 'to');
 345
 346   # Give HTML representation:
 347   my $html = SL::Presenter->get->grouped_record_list($records);
 348
 349 =head1 OVERVIEW
 350
 351 TODO
 352
 353 =head1 FUNCTIONS
 354
 355 =over 4
 356
 357 =item C<empty_record_list>
 358
 359 Returns a rendered version (actually an instance of
 360 L<SL::Presenter::EscapedText>) of an empty list of records. Is usually
 361 only called by L<grouped_record_list> if its list is empty.
 362
 363 =item C<grouped_record_list $list, %params>
 364
 365 Given a number of Rose::DB objects in the array reference C<$list>
 366 this function first groups them by type. Then it calls L<record_list>
 367 with each non-empty type-specific sub-list and the appropriate
 368 parameters for outputting a list of those records.
 369
 370 Returns a rendered version (actually an instance of
 371 L<SL::Presenter::EscapedText>) of all the lists.
 372
 373 The order in which the records are grouped is:
 374
 375 =over 2
 376
 377 =item * sales quotations
 378
 379 =item * sales orders
 380
 381 =item * sales delivery orders
 382
 383 =item * sales invoices
 384
 385 =item * AR transactions
 386
 387 =item * requests for quotations
 388
 389 =item * purchase orders
 390
 391 =item * purchase delivery orders
 392
 393 =item * purchase invoices
 394
 395 =item * AP transactions
 396
 397 =back
 398
 399 Objects of unknown types are skipped.
 400
 401 =item C<record_list $list, %params>
 402
 403 Returns a rendered version (actually an instance of
 404 L<SL::Presenter::EscapedText>) of a list of records. This list
 405 consists of a heading and a tabular representation of the list.
 406
 407 The parameters include:
 408
 409 =over 2
 410
 411 =item C<title>
 412
 413 Mandatory. The title to use in the heading. Must already be
 414 translated.
 415
 416 =item C<columns>
 417
 418 Mandatory. An array reference of column specs to output. Each column
 419 spec can be either an array reference or a hash reference.
 420
 421 If a column spec is an array reference then the first element is the
 422 column's name shown in the table header. It must already be translated.
 423
 424 The second element can be either a string or a code reference. A
 425 string is taken as the name of a function to call on the Rose::DB
 426 object for the current row. Its return value is formatted depending on
 427 the column's type (e.g. dates are output as the user expects them,
 428 floating point numbers are rounded to two decimal places and
 429 right-aligned etc). If it is a code reference then that code is called
 430 with the object as the first argument. Its return value should be an
 431 instance of L<SL::Presenter::EscapedText> and contain the rendered
 432 representation of the content to output.
 433
 434 The third element, if present, can be a link to which the column will
 435 be linked.
 436
 437 If the column spec is a hash reference then the same arguments are
 438 expected. The corresponding hash keys are C<title>, C<data> and
 439 C<link>.
 440
 441 =back
 442
 443 =back
 444
 445 =head1 BUGS
 446
 447 Nothing here yet.
 448
 449 =head1 AUTHOR
 450
 451 Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>
 452
 453 =cut