SL/ReportGenerator.pm

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