SL/ReportGenerator.pm

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