SL/ReportGenerator.pm

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