SL/ReportGenerator.pm

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