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 %params     = @_;
 490   my $variables  = $self->prepare_html_content();
 491   my $form       = $self->{form};
 492   my $myconfig   = $self->{myconfig};
 493
 494   my $opts       = $self->{options};
 495   my $pdfopts    = $opts->{pdf_export};
 496
 497   my (@data, @column_props, @cell_props);
 498
 499   my ($data_row, $cell_props_row);
 500   my @visible_columns = $self->get_visible_columns('PDF');
 501   my $num_columns     = scalar @visible_columns;
 502   my $num_header_rows = 1;
 503
 504   my $font_encoding   = 'UTF-8';
 505
 506   foreach my $name (@visible_columns) {
 507     push @column_props, { 'justify' => $self->{columns}->{$name}->{align} eq 'right' ? 'right' : 'left' };
 508   }
 509
 510   if (!$self->{custom_headers}) {
 511     $data_row       = [];
 512     $cell_props_row = [];
 513     push @data,       $data_row;
 514     push @cell_props, $cell_props_row;
 515
 516     foreach my $name (@visible_columns) {
 517       my $column = $self->{columns}->{$name};
 518
 519       push @{ $data_row },       $column->{text};
 520       push @{ $cell_props_row }, {};
 521     }
 522
 523   } else {
 524     $num_header_rows = scalar @{ $self->{custom_headers} };
 525
 526     foreach my $custom_header_row (@{ $self->{custom_headers} }) {
 527       $data_row       = [];
 528       $cell_props_row = [];
 529       push @data,       $data_row;
 530       push @cell_props, $cell_props_row;
 531
 532       foreach my $custom_header_col (@{ $custom_header_row }) {
 533         push @{ $data_row }, $custom_header_col->{text};
 534
 535         my $num_output  = ($custom_header_col->{colspan} * 1 > 1) ? $custom_header_col->{colspan} : 1;
 536         if ($num_output > 1) {
 537           push @{ $data_row },       ('') x ($num_output - 1);
 538           push @{ $cell_props_row }, { 'colspan' => $num_output };
 539           push @{ $cell_props_row }, ({ }) x ($num_output - 1);
 540
 541         } else {
 542           push @{ $cell_props_row }, {};
 543         }
 544       }
 545     }
 546   }
 547
 548   foreach my $row_set (@{ $self->{data} }) {
 549     if ('HASH' eq ref $row_set) {
 550       if ($row_set->{type} eq 'colspan_data') {
 551         push @data, [ $row_set->{data} ];
 552
 553         $cell_props_row = [];
 554         push @cell_props, $cell_props_row;
 555
 556         foreach (0 .. $num_columns - 1) {
 557           push @{ $cell_props_row }, { 'background_color' => '#666666',
 558                #  BUG PDF:Table  -> 0.9.12:
 559                # font_color is used in next row, so dont set font_color
 560                #                       'font_color'       => '#ffffff',
 561                                        'colspan'          => $_ == 0 ? -1 : undef, };
 562         }
 563       }
 564       next;
 565     }
 566
 567     foreach my $row (@{ $row_set }) {
 568       $data_row       = [];
 569       $cell_props_row = [];
 570
 571       push @data,       $data_row;
 572       push @cell_props, $cell_props_row;
 573
 574       my $col_idx = 0;
 575       foreach my $col_name (@visible_columns) {
 576         my $col = $row->{$col_name};
 577         push @{ $data_row }, join("\n", @{ $col->{data} || [] });
 578
 579         $column_props[$col_idx]->{justify} = 'right' if ($col->{align} eq 'right');
 580
 581         my $cell_props = { };
 582         push @{ $cell_props_row }, $cell_props;
 583
 584         if ($col->{colspan} && $col->{colspan} > 1) {
 585           $cell_props->{colspan} = $col->{colspan};
 586         }
 587
 588         $col_idx++;
 589       }
 590     }
 591   }
 592
 593   foreach my $i (0 .. scalar(@data) - 1) {
 594     my $aref             = $data[$i];
 595     my $num_columns_here = scalar @{ $aref };
 596
 597     if ($num_columns_here < $num_columns) {
 598       push @{ $aref }, ('') x ($num_columns - $num_columns_here);
 599     } elsif ($num_columns_here > $num_columns) {
 600       splice @{ $aref }, $num_columns;
 601     }
 602   }
 603
 604   my $papersizes = {
 605     'a3'         => [ 842, 1190 ],
 606     'a4'         => [ 595,  842 ],
 607     'a5'         => [ 420,  595 ],
 608     'letter'     => [ 612,  792 ],
 609     'legal'      => [ 612, 1008 ],
 610   };
 611
 612   my %supported_fonts = map { $_ => 1 } qw(courier georgia helvetica times verdana);
 613
 614   my $paper_size  = defined $pdfopts->{paper_size} && defined $papersizes->{lc $pdfopts->{paper_size}} ? lc $pdfopts->{paper_size} : 'a4';
 615   my ($paper_width, $paper_height);
 616
 617   if (lc $pdfopts->{orientation} eq 'landscape') {
 618     ($paper_width, $paper_height) = @{$papersizes->{$paper_size}}[1, 0];
 619   } else {
 620     ($paper_width, $paper_height) = @{$papersizes->{$paper_size}}[0, 1];
 621   }
 622
 623   my $margin_top        = _cm2bp($pdfopts->{margin_top}    || 1.5);
 624   my $margin_bottom     = _cm2bp($pdfopts->{margin_bottom} || 1.5);
 625   my $margin_left       = _cm2bp($pdfopts->{margin_left}   || 1.5);
 626   my $margin_right      = _cm2bp($pdfopts->{margin_right}  || 1.5);
 627
 628   my $table             = PDF::Table->new();
 629   my $pdf               = PDF::API2->new();
 630   my $page              = $pdf->page();
 631
 632   $pdf->mediabox($paper_width, $paper_height);
 633
 634   my $font              = $pdf->corefont(defined $pdfopts->{font_name} && $supported_fonts{lc $pdfopts->{font_name}} ? ucfirst $pdfopts->{font_name} : 'Verdana',
 635                                          '-encoding' => $font_encoding);
 636   my $font_size         = $pdfopts->{font_size} || 7;
 637   my $title_font_size   = $font_size + 1;
 638   my $padding           = 1;
 639   my $font_height       = $font_size + 2 * $padding;
 640   my $title_font_height = $font_size + 2 * $padding;
 641
 642   my $header_height     = $opts->{title}     ? 2 * $title_font_height : undef;
 643   my $footer_height     = $pdfopts->{number} ? 2 * $font_height       : undef;
 644
 645   my $top_text_height   = 0;
 646
 647   if ($self->{options}->{top_info_text}) {
 648     my $top_text     =  $self->{options}->{top_info_text};
 649     $top_text        =~ s/\r//g;
 650     $top_text        =~ s/\n+$//;
 651
 652     my @lines        =  split m/\n/, $top_text;
 653     $top_text_height =  $font_height * scalar @lines;
 654
 655     foreach my $line_no (0 .. scalar(@lines) - 1) {
 656       my $y_pos    = $paper_height - $margin_top - $header_height - $line_no * $font_height;
 657       my $text_obj = $page->text();
 658
 659       $text_obj->font($font, $font_size);
 660       $text_obj->translate($margin_left, $y_pos);
 661       $text_obj->text($lines[$line_no]);
 662     }
 663   }
 664
 665   $table->table($pdf,
 666                 $page,
 667                 \@data,
 668                 'x'                     => $margin_left,
 669                 'w'                     => $paper_width - $margin_left - $margin_right,
 670                 'start_y'               => $paper_height - $margin_top                  - $header_height                  - $top_text_height,
 671                 'next_y'                => $paper_height - $margin_top                  - $header_height,
 672                 'start_h'               => $paper_height - $margin_top - $margin_bottom - $header_height - $footer_height - $top_text_height,
 673                 'next_h'                => $paper_height - $margin_top - $margin_bottom - $header_height - $footer_height,
 674                 'padding'               => 1,
 675                 'background_color_odd'  => '#ffffff',
 676                 'background_color_even' => '#eeeeee',
 677                 'font'                  => $font,
 678                 'font_size'             => $font_size,
 679                 'font_color'            => '#000000',
 680                 'num_header_rows'       => $num_header_rows,
 681                 'header_props'          => {
 682                   'bg_color'            => '#ffffff',
 683                   'repeat'              => 1,
 684                   'font_color'          => '#000000',
 685                 },
 686                 'column_props'          => \@column_props,
 687                 'cell_props'            => \@cell_props,
 688                 'max_word_length'       => 60,
 689                 'border'                => 0.5,
 690     );
 691
 692   foreach my $page_num (1..$pdf->pages()) {
 693     my $curpage  = $pdf->openpage($page_num);
 694
 695     if ($pdfopts->{number}) {
 696       my $label    = $main::locale->text("Page #1/#2", $page_num, $pdf->pages());
 697       my $text_obj = $curpage->text();
 698
 699       $text_obj->font($font, $font_size);
 700       $text_obj->translate(($paper_width - $margin_left - $margin_right) / 2 + $margin_left - $text_obj->advancewidth($label) / 2, $margin_bottom);
 701       $text_obj->text($label);
 702     }
 703
 704     if ($opts->{title}) {
 705       my $title    = $opts->{title};
 706       my $text_obj = $curpage->text();
 707
 708       $text_obj->font($font, $title_font_size);
 709       $text_obj->translate(($paper_width - $margin_left - $margin_right) / 2 + $margin_left - $text_obj->advancewidth($title) / 2,
 710                            $paper_height - $margin_top);
 711       $text_obj->text($title, '-underline' => 1);
 712     }
 713   }
 714
 715   my $content = $pdf->stringify();
 716
 717   $main::lxdebug->message(LXDebug->DEBUG2(),"addattachments ?? =".$form->{report_generator_addattachments}." GL=".$form->{GL});
 718   if ($form->{report_generator_addattachments} && $form->{GL}) {
 719     $content = $self->append_gl_pdf_attachments($form,$content);
 720   }
 721
 722   # 1. check if we return the report as binary pdf
 723   if ($params{want_binary_pdf}) {
 724     return $content;
 725   }
 726   # 2. check if we want and can directly print the report
 727   my $printer_command;
 728   if ($pdfopts->{print} && $pdfopts->{printer_id}) {
 729     $form->{printer_id} = $pdfopts->{printer_id};
 730     $form->get_printer_code($myconfig);
 731     $printer_command = $form->{printer_command};
 732   }
 733   if ($printer_command) {
 734     $self->_print_content('printer_command' => $printer_command,
 735                           'content'         => $content,
 736                           'copies'          => $pdfopts->{copies});
 737     $form->{report_generator_printed} = 1;
 738
 739   } else {
 740   # 3. default: redirect http with file attached
 741     my $filename = $self->get_attachment_basename();
 742
 743     print qq|content-type: application/pdf\n|;
 744     print qq|content-disposition: attachment; filename=${filename}.pdf\n\n|;
 745
 746     $::locale->with_raw_io(\*STDOUT, sub {
 747       print $content;
 748     });
 749   }
 750 }
 751
 752 sub verify_paper_size {
 753   my $self                 = shift;
 754   my $requested_paper_size = lc shift;
 755   my $default_paper_size   = shift;
 756
 757   my %allowed_paper_sizes  = map { $_ => 1 } qw(a3 a4 a5 letter legal);
 758
 759   return $allowed_paper_sizes{$requested_paper_size} ? $requested_paper_size : $default_paper_size;
 760 }
 761
 762 sub _print_content {
 763   my $self   = shift;
 764   my %params = @_;
 765
 766   foreach my $i (1 .. max $params{copies}, 1) {
 767     my $printer = IO::File->new("| $params{printer_command}");
 768     $main::form->error($main::locale->text('Could not spawn the printer command.')) if (!$printer);
 769     $printer->print($params{content});
 770     $printer->close();
 771   }
 772 }
 773
 774 sub _handle_quoting_and_encoding {
 775   my ($self, $text, $do_unquote, $encoding) = @_;
 776
 777   $text = $main::locale->unquote_special_chars('HTML', $text) if $do_unquote;
 778   $text = Encode::encode($encoding || 'UTF-8', $text);
 779
 780   return $text;
 781 }
 782
 783 sub generate_csv_content {
 784   my $self   = shift;
 785   my $stdout = ($::dispatcher->get_standard_filehandles)[1];
 786
 787   # Text::CSV_XS seems to downgrade to bytes already (see
 788   # SL/FCGIFixes.pm). Therefore don't let FCGI do that again.
 789   $::locale->with_raw_io($stdout, sub { $self->_generate_csv_content($stdout) });
 790 }
 791
 792 sub _generate_csv_content {
 793   my ($self, $stdout) = @_;
 794
 795   my %valid_sep_chars    = (';' => ';', ',' => ',', ':' => ':', 'TAB' => "\t");
 796   my %valid_escape_chars = ('"' => 1, "'" => 1);
 797   my %valid_quote_chars  = ('"' => 1, "'" => 1);
 798
 799   my $opts        = $self->{options}->{csv_export};
 800   my $eol         = $opts->{eol_style} eq 'DOS'               ? "\r\n"                              : "\n";
 801   my $sep_char    = $valid_sep_chars{$opts->{sep_char}}       ? $valid_sep_chars{$opts->{sep_char}} : ';';
 802   my $escape_char = $valid_escape_chars{$opts->{escape_char}} ? $opts->{escape_char}                : '"';
 803   my $quote_char  = $valid_quote_chars{$opts->{quote_char}}   ? $opts->{quote_char}                 : '"';
 804
 805   $escape_char    = $quote_char if ($opts->{escape_char} eq 'QUOTE_CHAR');
 806
 807   my $csv = Text::CSV_XS->new({ 'binary'      => 1,
 808                                 'sep_char'    => $sep_char,
 809                                 'escape_char' => $escape_char,
 810                                 'quote_char'  => $quote_char,
 811                                 'eol'         => $eol, });
 812
 813   my @visible_columns = $self->get_visible_columns('CSV');
 814
 815   if ($opts->{headers}) {
 816     if (!$self->{custom_headers}) {
 817       $csv->print($stdout, [ map { $self->_handle_quoting_and_encoding($self->{columns}->{$_}->{text}, 1, $opts->{encoding}) } @visible_columns ]);
 818
 819     } else {
 820       foreach my $row (@{ $self->{custom_headers} }) {
 821         my $fields = [ ];
 822
 823         foreach my $col (@{ $row }) {
 824           my $num_output = ($col->{colspan} && ($col->{colspan} > 1)) ? $col->{colspan} : 1;
 825           push @{ $fields }, ($self->_handle_quoting_and_encoding($col->{text}, 1, $opts->{encoding})) x $num_output;
 826         }
 827
 828         $csv->print($stdout, $fields);
 829       }
 830     }
 831   }
 832
 833   foreach my $row_set (@{ $self->{data} }) {
 834     next if ('ARRAY' ne ref $row_set);
 835     foreach my $row (@{ $row_set }) {
 836       my @data;
 837       my $skip_next = 0;
 838       foreach my $col (@visible_columns) {
 839         if ($skip_next) {
 840           $skip_next--;
 841           next;
 842         }
 843
 844         my $num_output = ($row->{$col}{colspan} && ($row->{$col}->{colspan} > 1)) ? $row->{$col}->{colspan} : 1;
 845         $skip_next     = $num_output - 1;
 846
 847         push @data, join($eol, map { s/\r?\n/$eol/g; $self->_handle_quoting_and_encoding($_, 0, $opts->{encoding}) } @{ $row->{$col}->{data} });
 848         push @data, ('') x $skip_next if ($skip_next);
 849       }
 850
 851       $csv->print($stdout, \@data);
 852     }
 853   }
 854 }
 855
 856 sub check_for_pdf_api {
 857   return eval { require PDF::API2; 1; } ? 1 : 0;
 858 }
 859
 860 1;
 861
 862 __END__
 863
 864 =head1 NAME
 865
 866 SL::ReportGenerator.pm: the kivitendo way of getting data in shape
 867
 868 =head1 SYNOPSIS
 869
 870   my $report = SL::ReportGenerator->new(\%myconfig, $form);
 871      $report->set_options(%options);                         # optional
 872      $report->set_columns(%column_defs);
 873      $report->set_sort_indicator($column, $direction);       # optional
 874      $report->add_data($row1, $row2, @more_rows);
 875      $report->generate_with_headers();
 876
 877 This creates a report object, sets a few columns, adds some data and generates a standard report.
 878 Sorting of columns will be alphabetic, and options will be set to their defaults.
 879 The report will be printed including table headers, html headers and http headers.
 880
 881 =head1 DESCRIPTION
 882
 883 Imagine the following scenario:
 884 There's a simple form, which loads some data from the database, and needs to print it out. You write a template for it.
 885 Then there may be more than one line. You add a loop in the template.
 886 Then there are some options made by the user, such as hidden columns. You add more to the template.
 887 Then it lacks usability. You want it to be able to sort the data. You add code for that.
 888 Then there are too many results, you need pagination, you want to print or export that data..... and so on.
 889
 890 The ReportGenerator class was designed because this exact scenario happened about half a dozen times in kivitendo.
 891 It's purpose is to manage all those formating, culling, sorting, and templating.
 892 Which makes it almost as complicated to use as doing the work by yourself.
 893
 894 =head1 FUNCTIONS
 895
 896 =over 4
 897
 898 =item new \%myconfig,$form,%options
 899
 900 Creates a new ReportGenerator object, sets all given options, and returns it.
 901
 902 =item set_columns %columns
 903
 904 Sets the columns available to this report.
 905
 906 =item set_column_order @columns
 907
 908 Sets the order of columns. Any columns not present here are appended in alphabetic order.
 909
 910 =item set_sort_indicator $column,$direction
 911
 912 Sets sorting of the table by specifying a column and a direction, where the direction will be evaluated to ascending if true.
 913 Note that this is only for displaying. The data has to have already been sorted when it was added.
 914
 915 =item add_data \@data
 916
 917 =item add_data \%data
 918
 919 Adds data to the report. A given hash_ref is interpreted as a single line of
 920 data, every array_ref as a collection of lines.  Every line will be expected to
 921 be in a key => value format. Note that the rows have to already have been
 922 sorted.
 923
 924 The ReportGenerator is only able to display pre-sorted data and to indicate by
 925 which column and in which direction the data has been sorted via visual clues
 926 in the column headers. It also provides links to invert the sort direction.
 927
 928 =item add_separator
 929
 930 Adds a separator line to the report.
 931
 932 =item add_control \%data
 933
 934 Adds a control element to the data. Control elements are an experimental feature to add functionality to a report the regular data cannot.
 935 Every control element needs to set IS_CONTROL_DATA, in order to be recognized by the template.
 936 Currently the only control element is a colspan element, which can be used as a mini header further down the report.
 937
 938 =item clear_data
 939
 940 Deletes all data added to the report, but keeps options set.
 941
 942 =item set_options %options
 943
 944 Sets options. For an incomplete list of options, see section configuration.
 945
 946 =item set_options_from_form
 947
 948 Tries to import options from the $form object given at creation
 949
 950 =item set_export_options $next_sub,@variable_list
 951
 952 Sets next_sub and additional variables needed for export.
 953
 954 =item get_attachment_basename
 955
 956 Returns the set attachment_basename option, or 'report' if nothing was set. See configuration for the option.
 957
 958 =item generate_with_headers
 959
 960 Parses the report, adds headers and prints it out. Headers depend on the option 'output_format',
 961 for example 'HTML' will add proper table headers, html headers and http headers. See configuration for this option.
 962
 963 =item get_visible_columns $format
 964
 965 Returns a list of columns that will be visible in the report after considering all options or match the given format.
 966
 967 =item html_format $value
 968
 969 Escapes HTML characters in $value and substitutes newlines with '<br>'. Returns the escaped $value.
 970
 971 =item prepare_html_content $column,$name,@column_headers
 972
 973 Parses the data, and sets internal data needed for certain output format. Must be called once before the template is invoked.
 974 Should not be called externally, since all render and generate functions invoke it anyway.
 975
 976 =item generate_html_content
 977
 978 The html generation function. Is invoked by generate_with_headers.
 979
 980 =item generate_pdf_content
 981
 982 The PDF generation function. It is invoked by generate_with_headers and renders the PDF with the PDF::API2 library.
 983
 984 If the param want_binary_pdf is set, the binary pdf stream will be returned.
 985 If $pdfopts->{print} && $pdfopts->{printer_id} are set, the pdf will be printed (output is directed to print command).
 986
 987 Otherwise and the default a html form with a downloadable file is returned.
 988
 989 =item generate_csv_content
 990
 991 The CSV generation function. Uses XS_CSV to parse the information into csv.
 992
 993 =back
 994
 995 =head1 CONFIGURATION
 996
 997 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.
 998
 999 =head2 General Options
1000
1001 =over 4
1002
1003 =item std_column_visibility
1004
1005 Standard column visibility. Used if no visibility is set. Use this to save the trouble of enabling every column. Default is no.
1006
1007 =item output_format
1008
1009 Output format. Used by generate_with_headers to determine the format. Supported options are HTML, CSV, and PDF. Default is HTML.
1010
1011 =item allow_pdf_export
1012
1013 Used to determine if a button for PDF export should be displayed. Default is yes.
1014
1015 =item allow_csv_export
1016
1017 Used to determine if a button for CSV export should be displayed. Default is yes.
1018
1019 =item html_template
1020
1021 The template to be used for HTML reports. Default is 'report_generator/html_report'.
1022
1023 =item controller_class
1024
1025 If this is used from a C<SL::Controller::Base> based controller class, pass the
1026 class name here and make sure C<SL::Controller::Helper::ReportGenerator> is
1027 used in the controller. That way the exports stay functional.
1028
1029 =back
1030
1031 =head2 PDF Options
1032
1033 =over 4
1034
1035 =item paper_size
1036
1037 Paper size. Default is a4. Supported paper sizes are a3, a4, a5, letter and legal.
1038
1039 =item orientation (landscape)
1040
1041 Landscape or portrait. Default is landscape.
1042
1043 =item font_name
1044
1045 Default is Verdana. Supported font names are Courier, Georgia, Helvetica, Times and Verdana. This option only affects the rendering with PDF::API2.
1046
1047 =item font_size
1048
1049 Default is 7. This option only affects the rendering with PDF::API2.
1050
1051 =item margin_top
1052
1053 =item margin_left
1054
1055 =item margin_bottom
1056
1057 =item margin_right
1058
1059 The paper margins in cm. They all default to 1.5.
1060
1061 =item number
1062
1063 Set to a true value if the pages should be numbered. Default is 1.
1064
1065 =item print
1066
1067 If set then the resulting PDF will be output to a printer. If not it will be downloaded by the user. Default is no.
1068
1069 =item printer_id
1070
1071 Default 0.
1072
1073 =item copies
1074
1075 Default 1.
1076
1077 =back
1078
1079 =head2 CSV Options
1080
1081 =over 4
1082
1083 =item quote_char
1084
1085 Character to enclose entries. Default is double quote (").
1086
1087 =item sep_char
1088
1089 Character to separate entries. Default is semicolon (;).
1090
1091 =item escape_char
1092
1093 Character to escape the quote_char. Default is double quote (").
1094
1095 =item eol_style
1096
1097 End of line style. Default is Unix.
1098
1099 =item headers
1100
1101 Include headers? Default is yes.
1102
1103 =item encoding
1104
1105 Character encoding. Default is UTF-8.
1106
1107 =back
1108
1109 =head1 SEE ALO
1110
1111 C<Template.pm>
1112
1113 =head1 MODULE AUTHORS
1114
1115 Moritz Bunkus E<lt>mbunkus@linet-services.deE<gt>
1116
1117 L<http://linet-services.de>