SL/ReportGenerator.pm

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