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