Kleinen Grammatikfehler behoben.
[kivitendo-erp.git] / SL / ReportGenerator.pm
1 package SL::ReportGenerator;
2
3 #use strict;
4
5 use Encode;
6 use IO::Wrap;
7 use List::Util qw(max);
8 use Text::CSV_XS;
9 use Text::Iconv;
10 #use PDF::API2;    # these two eat up to .75s on startup. only load them if we actually need them
11 #use PDF::Table;
12
13 use SL::Form;
14
15 # Cause locales.pl to parse these files:
16 # parse_html_template('report_generator/html_report')
17
18 sub new {
19   my $type = shift;
20
21   my $self = { };
22
23   $self->{myconfig} = shift;
24   $self->{form}     = shift;
25
26   $self->{data}     = [];
27   $self->{options}  = {
28     'std_column_visibility' => 0,
29     'output_format'         => 'HTML',
30     'allow_pdf_export'      => 1,
31     'allow_csv_export'      => 1,
32     'html_template'         => 'report_generator/html_report',
33     'pdf_export'            => {
34       'paper_size'          => 'a4',
35       'orientation'         => 'landscape',
36       'font_name'           => 'Verdana',
37       'font_size'           => '7',
38       'margin_top'          => 1.5,
39       'margin_left'         => 1.5,
40       'margin_bottom'       => 1.5,
41       'margin_right'        => 1.5,
42       'number'              => 1,
43       'print'               => 0,
44       'printer_id'          => 0,
45       'copies'              => 1,
46     },
47     'csv_export'            => {
48       'quote_char'          => '"',
49       'sep_char'            => ';',
50       'escape_char'         => '"',
51       'eol_style'           => 'Unix',
52       'headers'             => 1,
53     },
54   };
55   $self->{export}   = {
56     'nextsub'       => '',
57     'variable_list' => [],
58   };
59
60   $self->{data_present} = 0;
61
62   bless $self, $type;
63
64   $self->set_options(@_) if (@_);
65
66   return $self;
67 }
68
69 sub set_columns {
70   my $self    = shift;
71   my %columns = @_;
72
73   $self->{columns} = \%columns;
74
75   foreach my $column (values %{ $self->{columns} }) {
76     $column->{visible} = $self->{options}->{std_column_visibility} unless defined $column->{visible};
77   }
78
79   $self->set_column_order(sort keys %{ $self->{columns} });
80 }
81
82 sub set_column_order {
83   my $self    = shift;
84   my %seen;
85   $self->{column_order} = [ grep { !$seen{$_}++ } @_, sort keys %{ $self->{columns} } ];
86 }
87
88 sub set_sort_indicator {
89   my $self = shift;
90
91   $self->{options}->{sort_indicator_column}    = shift;
92   $self->{options}->{sort_indicator_direction} = shift;
93 }
94
95 sub add_data {
96   my $self = shift;
97
98   my $last_row_set;
99
100   while (my $arg = shift) {
101     my $row_set;
102
103     if ('ARRAY' eq ref $arg) {
104       $row_set = $arg;
105
106     } elsif ('HASH' eq ref $arg) {
107       $row_set = [ $arg ];
108
109     } else {
110       $self->{form}->error('Incorrect usage -- expecting hash or array ref');
111     }
112
113     my @columns_with_default_alignment = grep { defined $self->{columns}->{$_}->{align} } keys %{ $self->{columns} };
114
115     foreach my $row (@{ $row_set }) {
116       foreach my $column (@columns_with_default_alignment) {
117         $row->{$column}          ||= { };
118         $row->{$column}->{align}   = $self->{columns}->{$column}->{align} unless (defined $row->{$column}->{align});
119       }
120
121       foreach my $field (qw(data link)) {
122         map { $row->{$_}->{$field} = [ $row->{$_}->{$field} ] if (ref $row->{$_}->{$field} ne 'ARRAY') } keys %{ $row };
123       }
124     }
125
126     push @{ $self->{data} }, $row_set;
127     $last_row_set = $row_set;
128
129     $self->{data_present} = 1;
130   }
131
132   return $last_row_set;
133 }
134
135 sub add_separator {
136   my $self = shift;
137
138   push @{ $self->{data} }, { 'type' => 'separator' };
139 }
140
141 sub add_control {
142   my $self = shift;
143   my $data = shift;
144
145   push @{ $self->{data} }, $data;
146 }
147
148 sub clear_data {
149   my $self = shift;
150
151   $self->{data}         = [];
152   $self->{data_present} = 0;
153 }
154
155 sub set_options {
156   my $self    = shift;
157   my %options = @_;
158
159   while (my ($key, $value) = each %options) {
160     if ($key eq 'pdf_export') {
161       map { $self->{options}->{pdf_export}->{$_} = $value->{$_} } keys %{ $value };
162     } else {
163       $self->{options}->{$key} = $value;
164     }
165   }
166 }
167
168 sub set_options_from_form {
169   my $self     = shift;
170
171   my $form     = $self->{form};
172   my $myconfig = $self->{myconfig};
173
174   foreach my $key (qw(output_format)) {
175     my $full_key = "report_generator_${key}";
176     $self->{options}->{$key} = $form->{$full_key} if (defined $form->{$full_key});
177   }
178
179   foreach my $format (qw(pdf csv)) {
180     my $opts = $self->{options}->{"${format}_export"};
181     foreach my $key (keys %{ $opts }) {
182       my $full_key = "report_generator_${format}_options_${key}";
183       $opts->{$key} = $key =~ /^margin/ ? $form->parse_amount($myconfig, $form->{$full_key}) : $form->{$full_key};
184     }
185   }
186 }
187
188 sub set_export_options {
189   my $self        = shift;
190
191   $self->{export} = {
192     'nextsub'       => shift,
193     'variable_list' => [ @_ ],
194   };
195 }
196
197 sub set_custom_headers {
198   my $self = shift;
199
200   if (@_) {
201     $self->{custom_headers} = [ @_ ];
202   } else {
203     delete $self->{custom_headers};
204   }
205 }
206
207 sub get_attachment_basename {
208   my $self     = shift;
209   my $filename =  $self->{options}->{attachment_basename} || 'report';
210   $filename    =~ s|.*\\||;
211   $filename    =~ s|.*/||;
212
213   return $filename;
214 }
215
216 sub generate_with_headers {
217   my $self   = shift;
218   my $format = lc $self->{options}->{output_format};
219   my $form   = $self->{form};
220
221   if (!$self->{columns}) {
222     $form->error('Incorrect usage -- no columns specified');
223   }
224
225   if ($format eq 'html') {
226     my $title      = $form->{title};
227     $form->{title} = $self->{title} if ($self->{title});
228     $form->header();
229     $form->{title} = $title;
230
231     print $self->generate_html_content();
232
233   } elsif ($format eq 'csv') {
234     my $filename = $self->get_attachment_basename();
235     print qq|content-type: text/csv\n|;
236     print qq|content-disposition: attachment; filename=${filename}.csv\n\n|;
237     $self->generate_csv_content();
238
239   } elsif ($format eq 'pdf') {
240     $self->generate_pdf_content();
241
242   } else {
243     $form->error('Incorrect usage -- unknown format (supported are HTML, CSV, PDF)');
244   }
245 }
246
247 sub get_visible_columns {
248   my $self   = shift;
249   my $format = shift;
250
251   return grep { my $c = $self->{columns}->{$_}; $c && $c->{visible} && (($c->{visible} == 1) || ($c->{visible} =~ /\Q${format}\E/i)) } @{ $self->{column_order} };
252 }
253
254 sub html_format {
255   my $self  = shift;
256   my $value = shift;
257
258   $value =  $main::locale->quote_special_chars('HTML', $value);
259   $value =~ s/\r//g;
260   $value =~ s/\n/<br>/g;
261
262   return $value;
263 }
264
265 sub prepare_html_content {
266   my $self = shift;
267
268   my ($column, $name, @column_headers);
269
270   my $opts            = $self->{options};
271   my @visible_columns = $self->get_visible_columns('HTML');
272
273   foreach $name (@visible_columns) {
274     $column = $self->{columns}->{$name};
275
276     my $header = {
277       'name'                     => $name,
278       'align'                    => $column->{align},
279       'link'                     => $column->{link},
280       'text'                     => $column->{text},
281       'show_sort_indicator'      => $name eq $opts->{sort_indicator_column},
282       'sort_indicator_direction' => $opts->{sort_indicator_direction},
283     };
284
285     push @column_headers, $header;
286   }
287
288   my $header_rows;
289   if ($self->{custom_headers}) {
290     $header_rows = $self->{custom_headers};
291   } else {
292     $header_rows = [ \@column_headers ];
293   }
294
295   my ($outer_idx, $inner_idx) = (0, 0);
296   my $next_border_top;
297   my @rows;
298
299   foreach my $row_set (@{ $self->{data} }) {
300     if ('HASH' eq ref $row_set) {
301       if ($row_set->{type} eq 'separator') {
302         if (! scalar @rows) {
303           $next_border_top = 1;
304         } else {
305           $rows[-1]->{BORDER_BOTTOM} = 1;
306         }
307
308         next;
309       }
310
311       my $row_data = {
312         'IS_CONTROL'      => 1,
313         'IS_COLSPAN_DATA' => $row_set->{type} eq 'colspan_data',
314         'NUM_COLUMNS'     => scalar @visible_columns,
315         'BORDER_TOP'      => $next_border_top,
316         'data'            => $row_set->{data},
317       };
318
319       push @rows, $row_data;
320
321       $next_border_top = 0;
322
323       next;
324     }
325
326     $outer_idx++;
327
328     foreach my $row (@{ $row_set }) {
329       $inner_idx++;
330
331       my $output_columns = [ ];
332       my $skip_next      = 0;
333       foreach my $col_name (@visible_columns) {
334         if ($skip_next) {
335           $skip_next--;
336           next;
337         }
338
339         my $col = $row->{$col_name};
340         $col->{CELL_ROWS} = [ ];
341         foreach my $i (0 .. scalar(@{ $col->{data} }) - 1) {
342           push @{ $col->{CELL_ROWS} }, {
343             'data' => $self->html_format($col->{data}->[$i]),
344             'link' => $col->{link}->[$i],
345           };
346         }
347
348         # Force at least a &nbsp; to be displayed so that browsers
349         # will format the table cell (e.g. borders etc).
350         if (!scalar @{ $col->{CELL_ROWS} }) {
351           push @{ $col->{CELL_ROWS} }, { 'data' => '&nbsp;' };
352         } elsif ((1 == scalar @{ $col->{CELL_ROWS} }) && (!defined $col->{CELL_ROWS}->[0]->{data} || ($col->{CELL_ROWS}->[0]->{data} eq ''))) {
353           $col->{CELL_ROWS}->[0]->{data} = '&nbsp;';
354         }
355
356         push @{ $output_columns }, $col;
357         $skip_next = $col->{colspan} ? $col->{colspan} - 1 : 0;
358       }
359
360       my $row_data = {
361         'COLUMNS'       => $output_columns,
362         'outer_idx'     => $outer_idx,
363         'outer_idx_odd' => $outer_idx % 2,
364         'inner_idx'     => $inner_idx,
365         'BORDER_TOP'    => $next_border_top,
366       };
367
368       push @rows, $row_data;
369
370       $next_border_top = 0;
371     }
372   }
373
374   my @export_variables = $self->{form}->flatten_variables(@{ $self->{export}->{variable_list} });
375
376   my $allow_pdf_export = $opts->{allow_pdf_export};
377
378   my $variables = {
379     'TITLE'                => $opts->{title},
380     'TOP_INFO_TEXT'        => $self->html_format($opts->{top_info_text}),
381     'RAW_TOP_INFO_TEXT'    => $opts->{raw_top_info_text},
382     'BOTTOM_INFO_TEXT'     => $self->html_format($opts->{bottom_info_text}),
383     'RAW_BOTTOM_INFO_TEXT' => $opts->{raw_bottom_info_text},
384     'ALLOW_PDF_EXPORT'     => $allow_pdf_export,
385     'ALLOW_CSV_EXPORT'     => $opts->{allow_csv_export},
386     'SHOW_EXPORT_BUTTONS'  => ($allow_pdf_export || $opts->{allow_csv_export}) && $self->{data_present},
387     'HEADER_ROWS'          => $header_rows,
388     'NUM_COLUMNS'          => scalar @column_headers,
389     'ROWS'                 => \@rows,
390     'EXPORT_VARIABLES'     => \@export_variables,
391     'EXPORT_VARIABLE_LIST' => join(' ', @{ $self->{export}->{variable_list} }),
392     'EXPORT_NEXTSUB'       => $self->{export}->{nextsub},
393     'DATA_PRESENT'         => $self->{data_present},
394   };
395
396   return $variables;
397 }
398
399 sub generate_html_content {
400   my $self      = shift;
401   my $variables = $self->prepare_html_content();
402
403   return $self->{form}->parse_html_template($self->{options}->{html_template}, $variables);
404 }
405
406 sub _cm2bp {
407   # 1 bp = 1/72 in
408   # 1 in = 2.54 cm
409   return $_[0] * 72 / 2.54;
410 }
411
412 sub _decode_text {
413   my $self = shift;
414   my $text = shift;
415
416   $text    = decode('UTF-8', $text) if ($self->{text_is_utf8});
417
418   return $text;
419 }
420
421 sub generate_pdf_content {
422   eval {
423     require PDF::API2;
424     require PDF::Table;
425   };
426
427   my $self       = shift;
428   my $variables  = $self->prepare_html_content();
429   my $form       = $self->{form};
430   my $myconfig   = $self->{myconfig};
431
432   my $opts       = $self->{options};
433   my $pdfopts    = $opts->{pdf_export};
434
435   my (@data, @column_props, @cell_props);
436
437   my ($data_row, $cell_props_row);
438   my @visible_columns = $self->get_visible_columns('HTML');
439   my $num_columns     = scalar @visible_columns;
440   my $num_header_rows = 1;
441
442   my $font_encoding     = $main::dbcharset || 'ISO-8859-15';
443   $self->{text_is_utf8} = $font_encoding =~ m/^utf-?8$/i;
444
445   foreach my $name (@visible_columns) {
446     push @column_props, { 'justify' => $self->{columns}->{$name}->{align} eq 'right' ? 'right' : 'left' };
447   }
448
449   if (!$self->{custom_headers}) {
450     $data_row       = [];
451     $cell_props_row = [];
452     push @data,       $data_row;
453     push @cell_props, $cell_props_row;
454
455     foreach my $name (@visible_columns) {
456       my $column = $self->{columns}->{$name};
457
458       push @{ $data_row },       $self->_decode_text($column->{text});
459       push @{ $cell_props_row }, {};
460     }
461
462   } else {
463     $num_header_rows = scalar @{ $self->{custom_headers} };
464
465     foreach my $custom_header_row (@{ $self->{custom_headers} }) {
466       $data_row       = [];
467       $cell_props_row = [];
468       push @data,       $data_row;
469       push @cell_props, $cell_props_row;
470
471       foreach my $custom_header_col (@{ $custom_header_row }) {
472         push @{ $data_row }, $self->_decode_text($custom_header_col->{text});
473
474         my $num_output  = ($custom_header_col->{colspan} * 1 > 1) ? $custom_header_col->{colspan} : 1;
475         if ($num_output > 1) {
476           push @{ $data_row },       ('') x ($num_output - 1);
477           push @{ $cell_props_row }, { 'colspan' => $num_output };
478           push @{ $cell_props_row }, ({ }) x ($num_output - 1);
479
480         } else {
481           push @{ $cell_props_row }, {};
482         }
483       }
484     }
485   }
486
487   foreach my $row_set (@{ $self->{data} }) {
488     if ('HASH' eq ref $row_set) {
489       if ($row_set->{type} eq 'colspan_data') {
490         push @data, [ $self->_decode_text($row_set->{data}) ];
491
492         $cell_props_row = [];
493         push @cell_props, $cell_props_row;
494
495         foreach (0 .. $num_columns - 1) {
496           push @{ $cell_props_row }, { 'background_color' => '#666666',
497                                        'font_color'       => '#ffffff',
498                                        'colspan'          => $_ == 0 ? -1 : undef, };
499         }
500       }
501       next;
502     }
503
504     foreach my $row (@{ $row_set }) {
505       $data_row       = [];
506       $cell_props_row = [];
507
508       push @data,       $data_row;
509       push @cell_props, $cell_props_row;
510
511       my $col_idx = 0;
512       foreach my $col_name (@visible_columns) {
513         my $col = $row->{$col_name};
514         push @{ $data_row }, $self->_decode_text(join("\n", @{ $col->{data} }));
515
516         $column_props[$col_idx]->{justify} = 'right' if ($col->{align} eq 'right');
517
518         my $cell_props = { };
519         push @{ $cell_props_row }, $cell_props;
520
521         if ($col->{colspan} && $col->{colspan} > 1) {
522           $cell_props->{colspan} = $col->{colspan};
523         }
524
525         $col_idx++;
526       }
527     }
528   }
529
530   foreach my $i (0 .. scalar(@data) - 1) {
531     my $aref             = $data[$i];
532     my $num_columns_here = scalar @{ $aref };
533
534     if ($num_columns_here < $num_columns) {
535       push @{ $aref }, ('') x ($num_columns - $num_columns_here);
536     } elsif ($num_columns_here > $num_columns) {
537       splice @{ $aref }, $num_columns;
538     }
539   }
540
541   my $papersizes = {
542     'a3'         => [ 842, 1190 ],
543     'a4'         => [ 595,  842 ],
544     'a5'         => [ 420,  595 ],
545     'letter'     => [ 612,  792 ],
546     'legal'      => [ 612, 1008 ],
547   };
548
549   my %supported_fonts = map { $_ => 1 } qw(courier georgia helvetica times verdana);
550
551   my $paper_size  = defined $pdfopts->{paper_size} && defined $papersizes->{lc $pdfopts->{paper_size}} ? lc $pdfopts->{paper_size} : 'a4';
552   my ($paper_width, $paper_height);
553
554   if (lc $pdfopts->{orientation} eq 'landscape') {
555     ($paper_width, $paper_height) = @{$papersizes->{$paper_size}}[1, 0];
556   } else {
557     ($paper_width, $paper_height) = @{$papersizes->{$paper_size}}[0, 1];
558   }
559
560   my $margin_top        = _cm2bp($pdfopts->{margin_top}    || 1.5);
561   my $margin_bottom     = _cm2bp($pdfopts->{margin_bottom} || 1.5);
562   my $margin_left       = _cm2bp($pdfopts->{margin_left}   || 1.5);
563   my $margin_right      = _cm2bp($pdfopts->{margin_right}  || 1.5);
564
565   my $table             = PDF::Table->new();
566   my $pdf               = PDF::API2->new();
567   my $page              = $pdf->page();
568
569   $pdf->mediabox($paper_width, $paper_height);
570
571   my $font              = $pdf->corefont(defined $pdfopts->{font_name} && $supported_fonts{lc $pdfopts->{font_name}} ? ucfirst $pdfopts->{font_name} : 'Verdana',
572                                          '-encoding' => $font_encoding);
573   my $font_size         = $pdfopts->{font_size} || 7;
574   my $title_font_size   = $font_size + 1;
575   my $padding           = 1;
576   my $font_height       = $font_size + 2 * $padding;
577   my $title_font_height = $font_size + 2 * $padding;
578
579   my $header_height     = 2 * $title_font_height if ($opts->{title});
580   my $footer_height     = 2 * $font_height       if ($pdfopts->{number});
581
582   my $top_text_height   = 0;
583
584   if ($self->{options}->{top_info_text}) {
585     my $top_text     =  $self->_decode_text($self->{options}->{top_info_text});
586     $top_text        =~ s/\r//g;
587     $top_text        =~ s/\n+$//;
588
589     my @lines        =  split m/\n/, $top_text;
590     $top_text_height =  $font_height * scalar @lines;
591
592     foreach my $line_no (0 .. scalar(@lines) - 1) {
593       my $y_pos    = $paper_height - $margin_top - $header_height - $line_no * $font_height;
594       my $text_obj = $page->text();
595
596       $text_obj->font($font, $font_size);
597       $text_obj->translate($margin_left, $y_pos);
598       $text_obj->text($lines[$line_no]);
599     }
600   }
601
602   $table->table($pdf,
603                 $page,
604                 \@data,
605                 'x'                     => $margin_left,
606                 'w'                     => $paper_width - $margin_left - $margin_right,
607                 'start_y'               => $paper_height - $margin_top                  - $header_height                  - $top_text_height,
608                 'next_y'                => $paper_height - $margin_top                  - $header_height,
609                 'start_h'               => $paper_height - $margin_top - $margin_bottom - $header_height - $footer_height - $top_text_height,
610                 'next_h'                => $paper_height - $margin_top - $margin_bottom - $header_height - $footer_height,
611                 'padding'               => 1,
612                 'background_color_odd'  => '#ffffff',
613                 'background_color_even' => '#eeeeee',
614                 'font'                  => $font,
615                 'font_size'             => $font_size,
616                 'font_color'            => '#000000',
617                 'num_header_rows'       => $num_header_rows,
618                 'header_props'          => {
619                   'bg_color'            => '#ffffff',
620                   'repeat'              => 1,
621                   'font_color'          => '#000000',
622                 },
623                 'column_props'          => \@column_props,
624                 'cell_props'            => \@cell_props,
625                 'max_word_length'       => 60,
626                 'border'                => 0.5,
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 and renders the PDF with the PDF::API2 library.
893
894 =item generate_csv_content
895
896 The CSV generation function. Uses XS_CSV to parse the information into csv.
897
898 =back
899
900 =head1 CONFIGURATION
901
902 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.
903
904 =head2 General Options
905
906 =over 4
907
908 =item std_column_visibility
909
910 Standard column visibility. Used if no visibility is set. Use this to save the trouble of enabling every column. Default is no.
911
912 =item output_format
913
914 Output format. Used by generate_with_headers to determine the format. Supported options are HTML, CSV, and PDF. Default is HTML.
915
916 =item allow_pdf_export
917
918 Used to determine if a button for PDF export should be displayed. Default is yes.
919
920 =item allow_csv_export
921
922 Used to determine if a button for CSV export should be displayed. Default is yes.
923
924 =item html_template
925
926 The template to be used for HTML reports. Default is 'report_generator/html_report'.
927
928 =back
929
930 =head2 PDF Options
931
932 =over 4
933
934 =item paper_size
935
936 Paper size. Default is a4. Supported paper sizes are a3, a4, a5, letter and legal.
937
938 =item orientation (landscape)
939
940 Landscape or portrait. Default is landscape.
941
942 =item font_name 
943
944 Default is Verdana. Supported font names are Courier, Georgia, Helvetica, Times and Verdana. This option only affects the rendering with PDF::API2.
945
946 =item font_size
947
948 Default is 7. This option only affects the rendering with PDF::API2.
949
950 =item margin_top
951
952 =item margin_left
953
954 =item margin_bottom
955
956 =item margin_right
957
958 The paper margins in cm. They all default to 1.5.
959
960 =item number
961
962 Set to a true value if the pages should be numbered. Default is 1.
963
964 =item print
965
966 If set then the resulting PDF will be output to a printer. If not it will be downloaded by the user. Default is no.
967
968 =item printer_id
969
970 Default 0.
971
972 =item copies
973
974 Default 1.
975
976 =back
977
978 =head2 CSV Options
979
980 =over 4
981
982 =item quote_char
983
984 Character to enclose entries. Default is double quote (").
985
986 =item sep_char
987
988 Character to separate entries. Default is semicolon (;).
989
990 =item escape_char
991
992 Character to escape the quote_char. Default is double quote (").
993
994 =item eol_style
995
996 End of line style. Default is Unix.
997
998 =item headers
999
1000 Include headers? Default is yes.
1001
1002 =back
1003
1004 =head1 SEE ALO
1005
1006 C<Template.pm>
1007
1008 =head1 MODULE AUTHORS
1009
1010 Moritz Bunkus E<lt>mbunkus@linet-services.deE<gt>
1011
1012 L<http://linet-services.de>