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