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