SL/ReportGenerator.pm

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