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