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