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