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