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