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