SL/ReportGenerator.pm

   1 package SL::ReportGenerator;
   2
   3 use Data::Dumper;
   4 use List::Util qw(max);
   5 use Scalar::Util qw(blessed);
   6 use Text::CSV_XS;
   7 #use PDF::API2;    # these two eat up to .75s on startup. only load them if we actually need them
   8 #use PDF::Table;
   9
  10 use strict;
  11 use SL::Helper::GlAttachments qw(append_gl_pdf_attachments);
  12 use SL::Helper::CreatePDF     qw(merge_pdfs);
  13
  14 # Cause locales.pl to parse these files:
  15 # parse_html_template('report_generator/html_report')
  16
  17 sub new {
  18   my $type = shift;
  19
  20   my $self = { };
  21
  22   $self->{myconfig} = shift;
  23   $self->{form}     = shift;
  24
  25   $self->{data}     = [];
  26   $self->{options}  = {
  27     'std_column_visibility' => 0,
  28     'output_format'         => 'HTML',
  29     'controller_class   '   => '',
  30     'allow_pdf_export'      => 1,
  31     'allow_csv_export'      => 1,
  32     'html_template'         => 'report_generator/html_report',
  33     'pdf_export'            => {
  34       'paper_size'          => 'a4',
  35       'orientation'         => 'landscape',
  36       'font_name'           => 'Verdana',
  37       'font_size'           => '7',
  38       'margin_top'          => 1.5,
  39       'margin_left'         => 1.5,
  40       'margin_bottom'       => 1.5,
  41       'margin_right'        => 1.5,
  42       'number'              => 1,
  43       'print'               => 0,
  44       'printer_id'          => 0,
  45       'copies'              => 1,
  46     },
  47     'csv_export'            => {
  48       'quote_char'          => '"',
  49       'sep_char'            => ';',
  50       'escape_char'         => '"',
  51       'eol_style'           => 'Unix',
  52       'headers'             => 1,
  53       'encoding'            => 'UTF-8',
  54     },
  55   };
  56   $self->{export}   = {
  57     'nextsub'       => '',
  58     'variable_list' => [],
  59   };
  60
  61   $self->{data_present} = 0;
  62
  63   bless $self, $type;
  64
  65   $self->set_options(@_) if (@_);
  66
  67   return $self;
  68 }
  69
  70 sub set_columns {
  71   my $self    = shift;
  72   my %columns = @_;
  73
  74   $self->{columns} = \%columns;
  75
  76   foreach my $column (values %{ $self->{columns} }) {
  77     $column->{visible} = $self->{options}->{std_column_visibility} unless defined $column->{visible};
  78   }
  79
  80   if( $::form->{report_generator_csv_options_for_import} ) {
  81     foreach my $key (keys %{ $self->{columns} }) {
  82       $self->{columns}{$key}{text} = $key;
  83     }
  84   }
  85
  86   $self->set_column_order(sort keys %{ $self->{columns} });
  87 }
  88
  89 sub set_column_order {
  90   my $self    = shift;
  91   my %seen;
  92   $self->{column_order} = [ grep { !$seen{$_}++ } @_, sort keys %{ $self->{columns} } ];
  93 }
  94
  95 sub set_sort_indicator {
  96   my $self = shift;
  97
  98   $self->{options}->{sort_indicator_column}    = shift;
  99   $self->{options}->{sort_indicator_direction} = shift;
 100 }
 101
 102 sub add_data {
 103   my $self = shift;
 104
 105   my $last_row_set;
 106
 107   while (my $arg = shift) {
 108     my $row_set;
 109
 110     if ('ARRAY' eq ref $arg) {
 111       $row_set = $arg;
 112
 113     } elsif ('HASH' eq ref $arg) {
 114       $row_set = [ $arg ];
 115
 116     } else {
 117       $self->{form}->error('Incorrect usage -- expecting hash or array ref');
 118     }
 119
 120     my @columns_with_default_alignment = grep { defined $self->{columns}->{$_}->{align} } keys %{ $self->{columns} };
 121
 122     foreach my $row (@{ $row_set }) {
 123       foreach my $column (@columns_with_default_alignment) {
 124         $row->{$column}          ||= { };
 125         $row->{$column}->{align}   = $self->{columns}->{$column}->{align} unless (defined $row->{$column}->{align});
 126       }
 127
 128       foreach my $field (qw(data link link_class)) {
 129         map { $row->{$_}->{$field} = [ $row->{$_}->{$field} ] if (ref $row->{$_}->{$field} ne 'ARRAY') } keys %{ $row };
 130       }
 131     }
 132
 133     push @{ $self->{data} }, $row_set;
 134     $last_row_set = $row_set;
 135
 136     $self->{data_present} = 1;
 137   }
 138
 139   return $last_row_set;
 140 }
 141
 142 sub add_separator {
 143   my $self = shift;
 144
 145   push @{ $self->{data} }, { 'type' => 'separator' };
 146 }
 147
 148 sub add_control {
 149   my $self = shift;
 150   my $data = shift;
 151
 152   push @{ $self->{data} }, $data;
 153 }
 154
 155 sub clear_data {
 156   my $self = shift;
 157
 158   $self->{data}         = [];
 159   $self->{data_present} = 0;
 160 }
 161
 162 sub set_options {
 163   my $self    = shift;
 164   my %options = @_;
 165
 166   while (my ($key, $value) = each %options) {
 167     if ($key eq 'pdf_export') {
 168       $self->{options}->{pdf_export}->{$_} = $value->{$_} for keys %{ $value };
 169     } elsif ($key eq 'csv_export') {
 170       $self->{options}->{csv_export}->{$_} = $value->{$_} for keys %{ $value };
 171     } else {
 172       $self->{options}->{$key} = $value;
 173     }
 174   }
 175 }
 176
 177 sub set_options_from_form {
 178   my $self     = shift;
 179
 180   my $form     = $self->{form};
 181   my $myconfig = $self->{myconfig};
 182
 183   foreach my $key (qw(output_format)) {
 184     my $full_key = "report_generator_${key}";
 185     $self->{options}->{$key} = $form->{$full_key} if (defined $form->{$full_key});
 186   }
 187
 188   foreach my $format (qw(pdf csv)) {
 189     my $opts = $self->{options}->{"${format}_export"};
 190     foreach my $key (keys %{ $opts }) {
 191       my $full_key = "report_generator_${format}_options_${key}";
 192       $opts->{$key} = $key =~ /^margin/ ? $form->parse_amount($myconfig, $form->{$full_key}) : $form->{$full_key};
 193     }
 194   }
 195 }
 196
 197 sub set_export_options {
 198   my $self        = shift;
 199
 200   $self->{export} = {
 201     'nextsub'       => shift,
 202     'variable_list' => [ @_ ],
 203   };
 204 }
 205
 206 sub set_custom_headers {
 207   my $self = shift;
 208
 209   if (@_) {
 210     $self->{custom_headers} = [ @_ ];
 211   } else {
 212     delete $self->{custom_headers};
 213   }
 214 }
 215
 216 sub get_attachment_basename {
 217   my $self     = shift;
 218   my $filename =  $self->{options}->{attachment_basename} || 'report';
 219
 220   # FIXME: this is bonkers. add a real sluggify method somewhere or import one.
 221   $filename    =~ s|.*\\||;
 222   $filename    =~ s|.*/||;
 223   $filename    =~ s| |_|g;
 224
 225   return $filename;
 226 }
 227
 228 sub generate_with_headers {
 229   my ($self, %params) = @_;
 230   my $format = lc $self->{options}->{output_format};
 231   my $form   = $self->{form};
 232
 233   if (!$self->{columns}) {
 234     $form->error('Incorrect usage -- no columns specified');
 235   }
 236
 237   if ($format eq 'html') {
 238     my $content    = $self->generate_html_content(%params);
 239     my $title      = $form->{title};
 240     $form->{title} = $self->{title} if ($self->{title});
 241     $form->header(no_layout => $params{no_layout});
 242     $form->{title} = $title;
 243
 244     print $content;
 245
 246   } elsif ($format eq 'csv') {
 247     # FIXME: don't do mini http in here
 248     my $filename = $self->get_attachment_basename();
 249     print qq|content-type: text/csv\n|;
 250     print qq|content-disposition: attachment; filename=${filename}.csv\n\n|;
 251     $::locale->with_raw_io(\*STDOUT, sub {
 252       $self->generate_csv_content();
 253     });
 254
 255   } elsif ($format eq 'pdf') {
 256     $self->generate_pdf_content();
 257
 258   } else {
 259     $form->error('Incorrect usage -- unknown format (supported are HTML, CSV, PDF)');
 260   }
 261 }
 262
 263 sub get_visible_columns {
 264   my $self   = shift;
 265   my $format = shift;
 266
 267   return grep { my $c = $self->{columns}->{$_}; $c && $c->{visible} && (($c->{visible} == 1) || ($c->{visible} =~ /\Q${format}\E/i)) } @{ $self->{column_order} };
 268 }
 269
 270 sub html_format {
 271   my $self  = shift;
 272   my $value = shift;
 273
 274   $value =  $main::locale->quote_special_chars('HTML', $value);
 275   $value =~ s/\r//g;
 276   $value =~ s/\n/<br>/g;
 277
 278   return $value;
 279 }
 280
 281 sub prepare_html_content {
 282   my ($self, %params) = @_;
 283
 284   my ($column, $name, @column_headers);
 285
 286   my $opts            = $self->{options};
 287   my @visible_columns = $self->get_visible_columns('HTML');
 288
 289   foreach $name (@visible_columns) {
 290     $column = $self->{columns}->{$name};
 291
 292     my $header = {
 293       'name'                     => $name,
 294       'align'                    => $column->{align},
 295       'link'                     => $column->{link},
 296       'text'                     => $column->{text},
 297       'raw_header_data'          => $column->{raw_header_data},
 298       'show_sort_indicator'      => $name eq $opts->{sort_indicator_column},
 299       'sort_indicator_direction' => $opts->{sort_indicator_direction},
 300     };
 301
 302     push @column_headers, $header;
 303   }
 304
 305   my $header_rows;
 306   if ($self->{custom_headers}) {
 307     $header_rows = $self->{custom_headers};
 308   } else {
 309     $header_rows = [ \@column_headers ];
 310   }
 311
 312   my ($outer_idx, $inner_idx) = (0, 0);
 313   my $next_border_top;
 314   my @rows;
 315
 316   foreach my $row_set (@{ $self->{data} }) {
 317     if ('HASH' eq ref $row_set) {
 318       if ($row_set->{type} eq 'separator') {
 319         if (! scalar @rows) {
 320           $next_border_top = 1;
 321         } else {
 322           $rows[-1]->{BORDER_BOTTOM} = 1;
 323         }
 324
 325         next;
 326       }
 327
 328       my $row_data = {
 329         'IS_CONTROL'      => 1,
 330         'IS_COLSPAN_DATA' => $row_set->{type} eq 'colspan_data',
 331         'NUM_COLUMNS'     => scalar @visible_columns,
 332         'BORDER_TOP'      => $next_border_top,
 333         'data'            => $row_set->{data},
 334       };
 335
 336       push @rows, $row_data;
 337
 338       $next_border_top = 0;
 339
 340       next;
 341     }
 342
 343     $outer_idx++;
 344
 345     foreach my $row (@{ $row_set }) {
 346       $inner_idx++;
 347
 348       my $output_columns = [ ];
 349       my $skip_next      = 0;
 350       foreach my $col_name (@visible_columns) {
 351         if ($skip_next) {
 352           $skip_next--;
 353           next;
 354         }
 355
 356         my $col = $row->{$col_name} || { data => [] };
 357         $col->{CELL_ROWS} = [ ];
 358         foreach my $i (0 .. scalar(@{ $col->{data} }) - 1) {
 359           push @{ $col->{CELL_ROWS} }, {
 360             'data' => '' . $self->html_format($col->{data}->[$i]),
 361             'link' => $col->{link}->[$i],
 362             link_class => $col->{link_class}->[$i],
 363           };
 364         }
 365
 366         # Force at least a &nbsp; to be displayed so that browsers
 367         # will format the table cell (e.g. borders etc).
 368         if (!scalar @{ $col->{CELL_ROWS} }) {
 369           push @{ $col->{CELL_ROWS} }, { 'data' => '&nbsp;' };
 370         } elsif ((1 == scalar @{ $col->{CELL_ROWS} }) && (!defined $col->{CELL_ROWS}->[0]->{data} || ($col->{CELL_ROWS}->[0]->{data} eq ''))) {
 371           $col->{CELL_ROWS}->[0]->{data} = '&nbsp;';
 372         }
 373
 374         push @{ $output_columns }, $col;
 375         $skip_next = $col->{colspan} ? $col->{colspan} - 1 : 0;
 376       }
 377
 378       my $row_data = {
 379         'COLUMNS'       => $output_columns,
 380         'outer_idx'     => $outer_idx,
 381         'outer_idx_odd' => $outer_idx % 2,
 382         'inner_idx'     => $inner_idx,
 383         'BORDER_TOP'    => $next_border_top,
 384       };
 385
 386       push @rows, $row_data;
 387
 388       $next_border_top = 0;
 389     }
 390   }
 391
 392   my @export_variables = $self->{form}->flatten_variables(@{ $self->{export}->{variable_list} });
 393
 394   my $allow_pdf_export = $opts->{allow_pdf_export};
 395
 396   my $variables = {
 397     'TITLE'                => $opts->{title},
 398     'TOP_INFO_TEXT'        => $self->html_format($opts->{top_info_text}),
 399     'RAW_TOP_INFO_TEXT'    => $opts->{raw_top_info_text},
 400     'BOTTOM_INFO_TEXT'     => $self->html_format($opts->{bottom_info_text}),
 401     'RAW_BOTTOM_INFO_TEXT' => $opts->{raw_bottom_info_text},
 402     'ALLOW_PDF_EXPORT'     => $allow_pdf_export,
 403     'ALLOW_CSV_EXPORT'     => $opts->{allow_csv_export},
 404     'SHOW_EXPORT_BUTTONS'  => ($allow_pdf_export || $opts->{allow_csv_export}) && $self->{data_present},
 405     'HEADER_ROWS'          => $header_rows,
 406     'NUM_COLUMNS'          => scalar @column_headers,
 407     'ROWS'                 => \@rows,
 408     'EXPORT_VARIABLES'     => \@export_variables,
 409     'EXPORT_VARIABLE_LIST' => join(' ', @{ $self->{export}->{variable_list} }),
 410     'EXPORT_NEXTSUB'       => $self->{export}->{nextsub},
 411     'DATA_PRESENT'         => $self->{data_present},
 412     'CONTROLLER_DISPATCH'  => $opts->{controller_class},
 413     'TABLE_CLASS'          => $opts->{table_class},
 414     'SKIP_BUTTONS'         => !!$params{action_bar},
 415   };
 416
 417   return $variables;
 418 }
 419
 420 sub create_action_bar_actions {
 421   my ($self, $variables) = @_;
 422
 423   my @actions;
 424   foreach my $type (qw(pdf csv)) {
 425     next unless $variables->{"ALLOW_" . uc($type) . "_EXPORT"};
 426
 427     my $key   = $variables->{CONTROLLER_DISPATCH} ? 'action' : 'report_generator_dispatch_to';
 428     my $value = "report_generator_export_as_${type}";
 429     $value    = $variables->{CONTROLLER_DISPATCH} . "/${value}" if $variables->{CONTROLLER_DISPATCH};
 430
 431     push @actions, action => [
 432       $type eq 'pdf' ? $::locale->text('PDF export') : $::locale->text('CSV export'),
 433       submit => [ '#report_generator_form', { $key => $value } ],
 434     ];
 435   }
 436
 437   if (scalar(@actions) > 1) {
 438     @actions = (
 439       combobox => [
 440         action => [ $::locale->text('Export') ],
 441         @actions,
 442       ],
 443     );
 444   }
 445
 446   return @actions;
 447 }
 448
 449 sub setup_action_bar {
 450   my ($self, $variables, %params) = @_;
 451
 452   my @actions = $self->create_action_bar_actions($variables);
 453
 454   if ($params{action_bar_setup_hook}) {
 455     $params{action_bar_setup_hook}->(@actions);
 456
 457   } elsif (@actions) {
 458     my $action_bar = blessed($params{action_bar}) ? $params{action_bar} : ($::request->layout->get('actionbar'))[0];
 459     $action_bar->add(@actions);
 460   }
 461 }
 462
 463 sub generate_html_content {
 464   my ($self, %params) = @_;
 465
 466   $params{action_bar} //= 1;
 467
 468   my $variables = $self->prepare_html_content(%params);
 469
 470   $self->setup_action_bar($variables, %params) if $params{action_bar};
 471
 472   my $stuff  = $self->{form}->parse_html_template($self->{options}->{html_template}, $variables);
 473   return $stuff;
 474 }
 475
 476 sub _cm2bp {
 477   # 1 bp = 1/72 in
 478   # 1 in = 2.54 cm
 479   return $_[0] * 72 / 2.54;
 480 }
 481
 482 sub generate_pdf_content {
 483   eval {
 484     require PDF::API2;
 485     require PDF::Table;
 486   };
 487
 488   my $self       = shift;
 489   my $variables  = $self->prepare_html_content();
 490   my $form       = $self->{form};
 491   my $myconfig   = $self->{myconfig};
 492
 493   my $opts       = $self->{options};
 494   my $pdfopts    = $opts->{pdf_export};
 495
 496   my (@data, @column_props, @cell_props);
 497
 498   my ($data_row, $cell_props_row);
 499   my @visible_columns = $self->get_visible_columns('PDF');
 500   my $num_columns     = scalar @visible_columns;
 501   my $num_header_rows = 1;
 502
 503   my $font_encoding   = 'UTF-8';
 504
 505   foreach my $name (@visible_columns) {
 506     push @column_props, { 'justify' => $self->{columns}->{$name}->{align} eq 'right' ? 'right' : 'left' };
 507   }
 508
 509   if (!$self->{custom_headers}) {
 510     $data_row       = [];
 511     $cell_props_row = [];
 512     push @data,       $data_row;
 513     push @cell_props, $cell_props_row;
 514
 515     foreach my $name (@visible_columns) {
 516       my $column = $self->{columns}->{$name};
 517
 518       push @{ $data_row },       $column->{text};
 519       push @{ $cell_props_row }, {};
 520     }
 521
 522   } else {
 523     $num_header_rows = scalar @{ $self->{custom_headers} };
 524
 525     foreach my $custom_header_row (@{ $self->{custom_headers} }) {
 526       $data_row       = [];
 527       $cell_props_row = [];
 528       push @data,       $data_row;
 529       push @cell_props, $cell_props_row;
 530
 531       foreach my $custom_header_col (@{ $custom_header_row }) {
 532         push @{ $data_row }, $custom_header_col->{text};
 533
 534         my $num_output  = ($custom_header_col->{colspan} * 1 > 1) ? $custom_header_col->{colspan} : 1;
 535         if ($num_output > 1) {
 536           push @{ $data_row },       ('') x ($num_output - 1);
 537           push @{ $cell_props_row }, { 'colspan' => $num_output };
 538           push @{ $cell_props_row }, ({ }) x ($num_output - 1);
 539
 540         } else {
 541           push @{ $cell_props_row }, {};
 542         }
 543       }
 544     }
 545   }
 546
 547   foreach my $row_set (@{ $self->{data} }) {
 548     if ('HASH' eq ref $row_set) {
 549       if ($row_set->{type} eq 'colspan_data') {
 550         push @data, [ $row_set->{data} ];
 551
 552         $cell_props_row = [];
 553         push @cell_props, $cell_props_row;
 554
 555         foreach (0 .. $num_columns - 1) {
 556           push @{ $cell_props_row }, { 'background_color' => '#666666',
 557                #  BUG PDF:Table  -> 0.9.12:
 558                # font_color is used in next row, so dont set font_color
 559                #                       'font_color'       => '#ffffff',
 560                                        'colspan'          => $_ == 0 ? -1 : undef, };
 561         }
 562       }
 563       next;
 564     }
 565
 566     foreach my $row (@{ $row_set }) {
 567       $data_row       = [];
 568       $cell_props_row = [];
 569
 570       push @data,       $data_row;
 571       push @cell_props, $cell_props_row;
 572
 573       my $col_idx = 0;
 574       foreach my $col_name (@visible_columns) {
 575         my $col = $row->{$col_name};
 576         push @{ $data_row }, join("\n", @{ $col->{data} || [] });
 577
 578         $column_props[$col_idx]->{justify} = 'right' if ($col->{align} eq 'right');
 579
 580         my $cell_props = { };
 581         push @{ $cell_props_row }, $cell_props;
 582
 583         if ($col->{colspan} && $col->{colspan} > 1) {
 584           $cell_props->{colspan} = $col->{colspan};
 585         }
 586
 587         $col_idx++;
 588       }
 589     }
 590   }
 591
 592   foreach my $i (0 .. scalar(@data) - 1) {
 593     my $aref             = $data[$i];
 594     my $num_columns_here = scalar @{ $aref };
 595
 596     if ($num_columns_here < $num_columns) {
 597       push @{ $aref }, ('') x ($num_columns - $num_columns_here);
 598     } elsif ($num_columns_here > $num_columns) {
 599       splice @{ $aref }, $num_columns;
 600     }
 601   }
 602
 603   my $papersizes = {
 604     'a3'         => [ 842, 1190 ],
 605     'a4'         => [ 595,  842 ],
 606     'a5'         => [ 420,  595 ],
 607     'letter'     => [ 612,  792 ],
 608     'legal'      => [ 612, 1008 ],
 609   };
 610
 611   my %supported_fonts = map { $_ => 1 } qw(courier georgia helvetica times verdana);
 612
 613   my $paper_size  = defined $pdfopts->{paper_size} && defined $papersizes->{lc $pdfopts->{paper_size}} ? lc $pdfopts->{paper_size} : 'a4';
 614   my ($paper_width, $paper_height);
 615
 616   if (lc $pdfopts->{orientation} eq 'landscape') {
 617     ($paper_width, $paper_height) = @{$papersizes->{$paper_size}}[1, 0];
 618   } else {
 619     ($paper_width, $paper_height) = @{$papersizes->{$paper_size}}[0, 1];
 620   }
 621
 622   my $margin_top        = _cm2bp($pdfopts->{margin_top}    || 1.5);
 623   my $margin_bottom     = _cm2bp($pdfopts->{margin_bottom} || 1.5);
 624   my $margin_left       = _cm2bp($pdfopts->{margin_left}   || 1.5);
 625   my $margin_right      = _cm2bp($pdfopts->{margin_right}  || 1.5);
 626
 627   my $table             = PDF::Table->new();
 628   my $pdf               = PDF::API2->new();
 629   my $page              = $pdf->page();
 630
 631   $pdf->mediabox($paper_width, $paper_height);
 632
 633   my $font              = $pdf->corefont(defined $pdfopts->{font_name} && $supported_fonts{lc $pdfopts->{font_name}} ? ucfirst $pdfopts->{font_name} : 'Verdana',
 634                                          '-encoding' => $font_encoding);
 635   my $font_size         = $pdfopts->{font_size} || 7;
 636   my $title_font_size   = $font_size + 1;
 637   my $padding           = 1;
 638   my $font_height       = $font_size + 2 * $padding;
 639   my $title_font_height = $font_size + 2 * $padding;
 640
 641   my $header_height     = $opts->{title}     ? 2 * $title_font_height : undef;
 642   my $footer_height     = $pdfopts->{number} ? 2 * $font_height       : undef;
 643
 644   my $top_text_height   = 0;
 645
 646   if ($self->{options}->{top_info_text}) {
 647     my $top_text     =  $self->{options}->{top_info_text};
 648     $top_text        =~ s/\r//g;
 649     $top_text        =~ s/\n+$//;
 650
 651     my @lines        =  split m/\n/, $top_text;
 652     $top_text_height =  $font_height * scalar @lines;
 653
 654     foreach my $line_no (0 .. scalar(@lines) - 1) {
 655       my $y_pos    = $paper_height - $margin_top - $header_height - $line_no * $font_height;
 656       my $text_obj = $page->text();
 657
 658       $text_obj->font($font, $font_size);
 659       $text_obj->translate($margin_left, $y_pos);
 660       $text_obj->text($lines[$line_no]);
 661     }
 662   }
 663
 664   $table->table($pdf,
 665                 $page,
 666                 \@data,
 667                 'x'                     => $margin_left,
 668                 'w'                     => $paper_width - $margin_left - $margin_right,
 669                 'start_y'               => $paper_height - $margin_top                  - $header_height                  - $top_text_height,
 670                 'next_y'                => $paper_height - $margin_top                  - $header_height,
 671                 'start_h'               => $paper_height - $margin_top - $margin_bottom - $header_height - $footer_height - $top_text_height,
 672                 'next_h'                => $paper_height - $margin_top - $margin_bottom - $header_height - $footer_height,
 673                 'padding'               => 1,
 674                 'background_color_odd'  => '#ffffff',
 675                 'background_color_even' => '#eeeeee',
 676                 'font'                  => $font,
 677                 'font_size'             => $font_size,
 678                 'font_color'            => '#000000',
 679                 'num_header_rows'       => $num_header_rows,
 680                 'header_props'          => {
 681                   'bg_color'            => '#ffffff',
 682                   'repeat'              => 1,
 683                   'font_color'          => '#000000',
 684                 },
 685                 'column_props'          => \@column_props,
 686                 'cell_props'            => \@cell_props,
 687                 'max_word_length'       => 60,
 688                 'border'                => 0.5,
 689     );
 690
 691   foreach my $page_num (1..$pdf->pages()) {
 692     my $curpage  = $pdf->openpage($page_num);
 693
 694     if ($pdfopts->{number}) {
 695       my $label    = $main::locale->text("Page #1/#2", $page_num, $pdf->pages());
 696       my $text_obj = $curpage->text();
 697
 698       $text_obj->font($font, $font_size);
 699       $text_obj->translate(($paper_width - $margin_left - $margin_right) / 2 + $margin_left - $text_obj->advancewidth($label) / 2, $margin_bottom);
 700       $text_obj->text($label);
 701     }
 702
 703     if ($opts->{title}) {
 704       my $title    = $opts->{title};
 705       my $text_obj = $curpage->text();
 706
 707       $text_obj->font($font, $title_font_size);
 708       $text_obj->translate(($paper_width - $margin_left - $margin_right) / 2 + $margin_left - $text_obj->advancewidth($title) / 2,
 709                            $paper_height - $margin_top);
 710       $text_obj->text($title, '-underline' => 1);
 711     }
 712   }
 713
 714   my $content = $pdf->stringify();
 715
 716   $main::lxdebug->message(LXDebug->DEBUG2(),"addattachments ?? =".$form->{report_generator_addattachments}." GL=".$form->{GL});
 717   if ($form->{report_generator_addattachments} && $form->{GL}) {
 718     $content = $self->append_gl_pdf_attachments($form,$content);
 719   }
 720
 721   my $printer_command;
 722   if ($pdfopts->{print} && $pdfopts->{printer_id}) {
 723     $form->{printer_id} = $pdfopts->{printer_id};
 724     $form->get_printer_code($myconfig);
 725     $printer_command = $form->{printer_command};
 726   }
 727
 728   if ($printer_command) {
 729     $self->_print_content('printer_command' => $printer_command,
 730                           'content'         => $content,
 731                           'copies'          => $pdfopts->{copies});
 732     $form->{report_generator_printed} = 1;
 733
 734   } else {
 735     my $filename = $self->get_attachment_basename();
 736
 737     print qq|content-type: application/pdf\n|;
 738     print qq|content-disposition: attachment; filename=${filename}.pdf\n\n|;
 739
 740     $::locale->with_raw_io(\*STDOUT, sub {
 741       print $content;
 742     });
 743   }
 744 }
 745
 746 sub verify_paper_size {
 747   my $self                 = shift;
 748   my $requested_paper_size = lc shift;
 749   my $default_paper_size   = shift;
 750
 751   my %allowed_paper_sizes  = map { $_ => 1 } qw(a3 a4 a5 letter legal);
 752
 753   return $allowed_paper_sizes{$requested_paper_size} ? $requested_paper_size : $default_paper_size;
 754 }
 755
 756 sub _print_content {
 757   my $self   = shift;
 758   my %params = @_;
 759
 760   foreach my $i (1 .. max $params{copies}, 1) {
 761     my $printer = IO::File->new("| $params{printer_command}");
 762     $main::form->error($main::locale->text('Could not spawn the printer command.')) if (!$printer);
 763     $printer->print($params{content});
 764     $printer->close();
 765   }
 766 }
 767
 768 sub _handle_quoting_and_encoding {
 769   my ($self, $text, $do_unquote, $encoding) = @_;
 770
 771   $text = $main::locale->unquote_special_chars('HTML', $text) if $do_unquote;
 772   $text = Encode::encode($encoding || 'UTF-8', $text);
 773
 774   return $text;
 775 }
 776
 777 sub generate_csv_content {
 778   my $self   = shift;
 779   my $stdout = ($::dispatcher->get_standard_filehandles)[1];
 780
 781   # Text::CSV_XS seems to downgrade to bytes already (see
 782   # SL/FCGIFixes.pm). Therefore don't let FCGI do that again.
 783   $::locale->with_raw_io($stdout, sub { $self->_generate_csv_content($stdout) });
 784 }
 785
 786 sub _generate_csv_content {
 787   my ($self, $stdout) = @_;
 788
 789   my %valid_sep_chars    = (';' => ';', ',' => ',', ':' => ':', 'TAB' => "\t");
 790   my %valid_escape_chars = ('"' => 1, "'" => 1);
 791   my %valid_quote_chars  = ('"' => 1, "'" => 1);
 792
 793   my $opts        = $self->{options}->{csv_export};
 794   my $eol         = $opts->{eol_style} eq 'DOS'               ? "\r\n"                              : "\n";
 795   my $sep_char    = $valid_sep_chars{$opts->{sep_char}}       ? $valid_sep_chars{$opts->{sep_char}} : ';';
 796   my $escape_char = $valid_escape_chars{$opts->{escape_char}} ? $opts->{escape_char}                : '"';
 797   my $quote_char  = $valid_quote_chars{$opts->{quote_char}}   ? $opts->{quote_char}                 : '"';
 798
 799   $escape_char    = $quote_char if ($opts->{escape_char} eq 'QUOTE_CHAR');
 800
 801   my $csv = Text::CSV_XS->new({ 'binary'      => 1,
 802                                 'sep_char'    => $sep_char,
 803                                 'escape_char' => $escape_char,
 804                                 'quote_char'  => $quote_char,
 805                                 'eol'         => $eol, });
 806
 807   my @visible_columns = $self->get_visible_columns('CSV');
 808
 809   if ($opts->{headers}) {
 810     if (!$self->{custom_headers}) {
 811       $csv->print($stdout, [ map { $self->_handle_quoting_and_encoding($self->{columns}->{$_}->{text}, 1, $opts->{encoding}) } @visible_columns ]);
 812
 813     } else {
 814       foreach my $row (@{ $self->{custom_headers} }) {
 815         my $fields = [ ];
 816
 817         foreach my $col (@{ $row }) {
 818           my $num_output = ($col->{colspan} && ($col->{colspan} > 1)) ? $col->{colspan} : 1;
 819           push @{ $fields }, ($self->_handle_quoting_and_encoding($col->{text}, 1, $opts->{encoding})) x $num_output;
 820         }
 821
 822         $csv->print($stdout, $fields);
 823       }
 824     }
 825   }
 826
 827   foreach my $row_set (@{ $self->{data} }) {
 828     next if ('ARRAY' ne ref $row_set);
 829     foreach my $row (@{ $row_set }) {
 830       my @data;
 831       my $skip_next = 0;
 832       foreach my $col (@visible_columns) {
 833         if ($skip_next) {
 834           $skip_next--;
 835           next;
 836         }
 837
 838         my $num_output = ($row->{$col}{colspan} && ($row->{$col}->{colspan} > 1)) ? $row->{$col}->{colspan} : 1;
 839         $skip_next     = $num_output - 1;
 840
 841         push @data, join($eol, map { s/\r?\n/$eol/g; $self->_handle_quoting_and_encoding($_, 0, $opts->{encoding}) } @{ $row->{$col}->{data} });
 842         push @data, ('') x $skip_next if ($skip_next);
 843       }
 844
 845       $csv->print($stdout, \@data);
 846     }
 847   }
 848 }
 849
 850 sub check_for_pdf_api {
 851   return eval { require PDF::API2; 1; } ? 1 : 0;
 852 }
 853
 854 1;
 855
 856 __END__
 857
 858 =head1 NAME
 859
 860 SL::ReportGenerator.pm: the kivitendo way of getting data in shape
 861
 862 =head1 SYNOPSIS
 863
 864   my $report = SL::ReportGenerator->new(\%myconfig, $form);
 865      $report->set_options(%options);                         # optional
 866      $report->set_columns(%column_defs);
 867      $report->set_sort_indicator($column, $direction);       # optional
 868      $report->add_data($row1, $row2, @more_rows);
 869      $report->generate_with_headers();
 870
 871 This creates a report object, sets a few columns, adds some data and generates a standard report.
 872 Sorting of columns will be alphabetic, and options will be set to their defaults.
 873 The report will be printed including table headers, html headers and http headers.
 874
 875 =head1 DESCRIPTION
 876
 877 Imagine the following scenario:
 878 There's a simple form, which loads some data from the database, and needs to print it out. You write a template for it.
 879 Then there may be more than one line. You add a loop in the template.
 880 Then there are some options made by the user, such as hidden columns. You add more to the template.
 881 Then it lacks usability. You want it to be able to sort the data. You add code for that.
 882 Then there are too many results, you need pagination, you want to print or export that data..... and so on.
 883
 884 The ReportGenerator class was designed because this exact scenario happened about half a dozen times in kivitendo.
 885 It's purpose is to manage all those formating, culling, sorting, and templating.
 886 Which makes it almost as complicated to use as doing the work by yourself.
 887
 888 =head1 FUNCTIONS
 889
 890 =over 4
 891
 892 =item new \%myconfig,$form,%options
 893
 894 Creates a new ReportGenerator object, sets all given options, and returns it.
 895
 896 =item set_columns %columns
 897
 898 Sets the columns available to this report.
 899
 900 =item set_column_order @columns
 901
 902 Sets the order of columns. Any columns not present here are appended in alphabetic order.
 903
 904 =item set_sort_indicator $column,$direction
 905
 906 Sets sorting of the table by specifying a column and a direction, where the direction will be evaluated to ascending if true.
 907 Note that this is only for displaying. The data has to have already been sorted when it was added.
 908
 909 =item add_data \@data
 910
 911 =item add_data \%data
 912
 913 Adds data to the report. A given hash_ref is interpreted as a single line of
 914 data, every array_ref as a collection of lines.  Every line will be expected to
 915 be in a key => value format. Note that the rows have to already have been
 916 sorted.
 917
 918 The ReportGenerator is only able to display pre-sorted data and to indicate by
 919 which column and in which direction the data has been sorted via visual clues
 920 in the column headers. It also provides links to invert the sort direction.
 921
 922 =item add_separator
 923
 924 Adds a separator line to the report.
 925
 926 =item add_control \%data
 927
 928 Adds a control element to the data. Control elements are an experimental feature to add functionality to a report the regular data cannot.
 929 Every control element needs to set IS_CONTROL_DATA, in order to be recognized by the template.
 930 Currently the only control element is a colspan element, which can be used as a mini header further down the report.
 931
 932 =item clear_data
 933
 934 Deletes all data added to the report, but keeps options set.
 935
 936 =item set_options %options
 937
 938 Sets options. For an incomplete list of options, see section configuration.
 939
 940 =item set_options_from_form
 941
 942 Tries to import options from the $form object given at creation
 943
 944 =item set_export_options $next_sub,@variable_list
 945
 946 Sets next_sub and additional variables needed for export.
 947
 948 =item get_attachment_basename
 949
 950 Returns the set attachment_basename option, or 'report' if nothing was set. See configuration for the option.
 951
 952 =item generate_with_headers
 953
 954 Parses the report, adds headers and prints it out. Headers depend on the option 'output_format',
 955 for example 'HTML' will add proper table headers, html headers and http headers. See configuration for this option.
 956
 957 =item get_visible_columns $format
 958
 959 Returns a list of columns that will be visible in the report after considering all options or match the given format.
 960
 961 =item html_format $value
 962
 963 Escapes HTML characters in $value and substitutes newlines with '<br>'. Returns the escaped $value.
 964
 965 =item prepare_html_content $column,$name,@column_headers
 966
 967 Parses the data, and sets internal data needed for certain output format. Must be called once before the template is invoked.
 968 Should not be called externally, since all render and generate functions invoke it anyway.
 969
 970 =item generate_html_content
 971
 972 The html generation function. Is invoked by generate_with_headers.
 973
 974 =item generate_pdf_content
 975
 976 The PDF generation function. It is invoked by generate_with_headers and renders the PDF with the PDF::API2 library.
 977
 978 =item generate_csv_content
 979
 980 The CSV generation function. Uses XS_CSV to parse the information into csv.
 981
 982 =back
 983
 984 =head1 CONFIGURATION
 985
 986 These are known options and their defaults. Options for pdf export and csv export need to be set as a hashref inside the export option.
 987
 988 =head2 General Options
 989
 990 =over 4
 991
 992 =item std_column_visibility
 993
 994 Standard column visibility. Used if no visibility is set. Use this to save the trouble of enabling every column. Default is no.
 995
 996 =item output_format
 997
 998 Output format. Used by generate_with_headers to determine the format. Supported options are HTML, CSV, and PDF. Default is HTML.
 999
1000 =item allow_pdf_export
1001
1002 Used to determine if a button for PDF export should be displayed. Default is yes.
1003
1004 =item allow_csv_export
1005
1006 Used to determine if a button for CSV export should be displayed. Default is yes.
1007
1008 =item html_template
1009
1010 The template to be used for HTML reports. Default is 'report_generator/html_report'.
1011
1012 =item controller_class
1013
1014 If this is used from a C<SL::Controller::Base> based controller class, pass the
1015 class name here and make sure C<SL::Controller::Helper::ReportGenerator> is
1016 used in the controller. That way the exports stay functional.
1017
1018 =back
1019
1020 =head2 PDF Options
1021
1022 =over 4
1023
1024 =item paper_size
1025
1026 Paper size. Default is a4. Supported paper sizes are a3, a4, a5, letter and legal.
1027
1028 =item orientation (landscape)
1029
1030 Landscape or portrait. Default is landscape.
1031
1032 =item font_name
1033
1034 Default is Verdana. Supported font names are Courier, Georgia, Helvetica, Times and Verdana. This option only affects the rendering with PDF::API2.
1035
1036 =item font_size
1037
1038 Default is 7. This option only affects the rendering with PDF::API2.
1039
1040 =item margin_top
1041
1042 =item margin_left
1043
1044 =item margin_bottom
1045
1046 =item margin_right
1047
1048 The paper margins in cm. They all default to 1.5.
1049
1050 =item number
1051
1052 Set to a true value if the pages should be numbered. Default is 1.
1053
1054 =item print
1055
1056 If set then the resulting PDF will be output to a printer. If not it will be downloaded by the user. Default is no.
1057
1058 =item printer_id
1059
1060 Default 0.
1061
1062 =item copies
1063
1064 Default 1.
1065
1066 =back
1067
1068 =head2 CSV Options
1069
1070 =over 4
1071
1072 =item quote_char
1073
1074 Character to enclose entries. Default is double quote (").
1075
1076 =item sep_char
1077
1078 Character to separate entries. Default is semicolon (;).
1079
1080 =item escape_char
1081
1082 Character to escape the quote_char. Default is double quote (").
1083
1084 =item eol_style
1085
1086 End of line style. Default is Unix.
1087
1088 =item headers
1089
1090 Include headers? Default is yes.
1091
1092 =item encoding
1093
1094 Character encoding. Default is UTF-8.
1095
1096 =back
1097
1098 =head1 SEE ALO
1099
1100 C<Template.pm>
1101
1102 =head1 MODULE AUTHORS
1103
1104 Moritz Bunkus E<lt>mbunkus@linet-services.deE<gt>
1105
1106 L<http://linet-services.de>