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