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