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