SL/ReportGenerator.pm

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