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