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