SL/ReportGenerator.pm

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