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