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