SL/ReportGenerator.pm

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