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