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