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