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