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