SL/ReportGenerator.pm

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