remove unnecessary spaces
[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 $variables  = $self->prepare_html_content();
490   my $form       = $self->{form};
491   my $myconfig   = $self->{myconfig};
492
493   my $opts       = $self->{options};
494   my $pdfopts    = $opts->{pdf_export};
495
496   my (@data, @column_props, @cell_props);
497
498   my ($data_row, $cell_props_row);
499   my @visible_columns = $self->get_visible_columns('PDF');
500   my $num_columns     = scalar @visible_columns;
501   my $num_header_rows = 1;
502
503   my $font_encoding   = 'UTF-8';
504
505   foreach my $name (@visible_columns) {
506     push @column_props, { 'justify' => $self->{columns}->{$name}->{align} eq 'right' ? 'right' : 'left' };
507   }
508
509   if (!$self->{custom_headers}) {
510     $data_row       = [];
511     $cell_props_row = [];
512     push @data,       $data_row;
513     push @cell_props, $cell_props_row;
514
515     foreach my $name (@visible_columns) {
516       my $column = $self->{columns}->{$name};
517
518       push @{ $data_row },       $column->{text};
519       push @{ $cell_props_row }, {};
520     }
521
522   } else {
523     $num_header_rows = scalar @{ $self->{custom_headers} };
524
525     foreach my $custom_header_row (@{ $self->{custom_headers} }) {
526       $data_row       = [];
527       $cell_props_row = [];
528       push @data,       $data_row;
529       push @cell_props, $cell_props_row;
530
531       foreach my $custom_header_col (@{ $custom_header_row }) {
532         push @{ $data_row }, $custom_header_col->{text};
533
534         my $num_output  = ($custom_header_col->{colspan} * 1 > 1) ? $custom_header_col->{colspan} : 1;
535         if ($num_output > 1) {
536           push @{ $data_row },       ('') x ($num_output - 1);
537           push @{ $cell_props_row }, { 'colspan' => $num_output };
538           push @{ $cell_props_row }, ({ }) x ($num_output - 1);
539
540         } else {
541           push @{ $cell_props_row }, {};
542         }
543       }
544     }
545   }
546
547   foreach my $row_set (@{ $self->{data} }) {
548     if ('HASH' eq ref $row_set) {
549       if ($row_set->{type} eq 'colspan_data') {
550         push @data, [ $row_set->{data} ];
551
552         $cell_props_row = [];
553         push @cell_props, $cell_props_row;
554
555         foreach (0 .. $num_columns - 1) {
556           push @{ $cell_props_row }, { 'background_color' => '#666666',
557                #  BUG PDF:Table  -> 0.9.12:
558                # font_color is used in next row, so dont set font_color
559                #                       'font_color'       => '#ffffff',
560                                        'colspan'          => $_ == 0 ? -1 : undef, };
561         }
562       }
563       next;
564     }
565
566     foreach my $row (@{ $row_set }) {
567       $data_row       = [];
568       $cell_props_row = [];
569
570       push @data,       $data_row;
571       push @cell_props, $cell_props_row;
572
573       my $col_idx = 0;
574       foreach my $col_name (@visible_columns) {
575         my $col = $row->{$col_name};
576         push @{ $data_row }, join("\n", @{ $col->{data} || [] });
577
578         $column_props[$col_idx]->{justify} = 'right' if ($col->{align} eq 'right');
579
580         my $cell_props = { };
581         push @{ $cell_props_row }, $cell_props;
582
583         if ($col->{colspan} && $col->{colspan} > 1) {
584           $cell_props->{colspan} = $col->{colspan};
585         }
586
587         $col_idx++;
588       }
589     }
590   }
591
592   foreach my $i (0 .. scalar(@data) - 1) {
593     my $aref             = $data[$i];
594     my $num_columns_here = scalar @{ $aref };
595
596     if ($num_columns_here < $num_columns) {
597       push @{ $aref }, ('') x ($num_columns - $num_columns_here);
598     } elsif ($num_columns_here > $num_columns) {
599       splice @{ $aref }, $num_columns;
600     }
601   }
602
603   my $papersizes = {
604     'a3'         => [ 842, 1190 ],
605     'a4'         => [ 595,  842 ],
606     'a5'         => [ 420,  595 ],
607     'letter'     => [ 612,  792 ],
608     'legal'      => [ 612, 1008 ],
609   };
610
611   my %supported_fonts = map { $_ => 1 } qw(courier georgia helvetica times verdana);
612
613   my $paper_size  = defined $pdfopts->{paper_size} && defined $papersizes->{lc $pdfopts->{paper_size}} ? lc $pdfopts->{paper_size} : 'a4';
614   my ($paper_width, $paper_height);
615
616   if (lc $pdfopts->{orientation} eq 'landscape') {
617     ($paper_width, $paper_height) = @{$papersizes->{$paper_size}}[1, 0];
618   } else {
619     ($paper_width, $paper_height) = @{$papersizes->{$paper_size}}[0, 1];
620   }
621
622   my $margin_top        = _cm2bp($pdfopts->{margin_top}    || 1.5);
623   my $margin_bottom     = _cm2bp($pdfopts->{margin_bottom} || 1.5);
624   my $margin_left       = _cm2bp($pdfopts->{margin_left}   || 1.5);
625   my $margin_right      = _cm2bp($pdfopts->{margin_right}  || 1.5);
626
627   my $table             = PDF::Table->new();
628   my $pdf               = PDF::API2->new();
629   my $page              = $pdf->page();
630
631   $pdf->mediabox($paper_width, $paper_height);
632
633   my $font              = $pdf->corefont(defined $pdfopts->{font_name} && $supported_fonts{lc $pdfopts->{font_name}} ? ucfirst $pdfopts->{font_name} : 'Verdana',
634                                          '-encoding' => $font_encoding);
635   my $font_size         = $pdfopts->{font_size} || 7;
636   my $title_font_size   = $font_size + 1;
637   my $padding           = 1;
638   my $font_height       = $font_size + 2 * $padding;
639   my $title_font_height = $font_size + 2 * $padding;
640
641   my $header_height     = $opts->{title}     ? 2 * $title_font_height : undef;
642   my $footer_height     = $pdfopts->{number} ? 2 * $font_height       : undef;
643
644   my $top_text_height   = 0;
645
646   if ($self->{options}->{top_info_text}) {
647     my $top_text     =  $self->{options}->{top_info_text};
648     $top_text        =~ s/\r//g;
649     $top_text        =~ s/\n+$//;
650
651     my @lines        =  split m/\n/, $top_text;
652     $top_text_height =  $font_height * scalar @lines;
653
654     foreach my $line_no (0 .. scalar(@lines) - 1) {
655       my $y_pos    = $paper_height - $margin_top - $header_height - $line_no * $font_height;
656       my $text_obj = $page->text();
657
658       $text_obj->font($font, $font_size);
659       $text_obj->translate($margin_left, $y_pos);
660       $text_obj->text($lines[$line_no]);
661     }
662   }
663
664   $table->table($pdf,
665                 $page,
666                 \@data,
667                 'x'                     => $margin_left,
668                 'w'                     => $paper_width - $margin_left - $margin_right,
669                 'start_y'               => $paper_height - $margin_top                  - $header_height                  - $top_text_height,
670                 'next_y'                => $paper_height - $margin_top                  - $header_height,
671                 'start_h'               => $paper_height - $margin_top - $margin_bottom - $header_height - $footer_height - $top_text_height,
672                 'next_h'                => $paper_height - $margin_top - $margin_bottom - $header_height - $footer_height,
673                 'padding'               => 1,
674                 'background_color_odd'  => '#ffffff',
675                 'background_color_even' => '#eeeeee',
676                 'font'                  => $font,
677                 'font_size'             => $font_size,
678                 'font_color'            => '#000000',
679                 'num_header_rows'       => $num_header_rows,
680                 'header_props'          => {
681                   'bg_color'            => '#ffffff',
682                   'repeat'              => 1,
683                   'font_color'          => '#000000',
684                 },
685                 'column_props'          => \@column_props,
686                 'cell_props'            => \@cell_props,
687                 'max_word_length'       => 60,
688                 'border'                => 0.5,
689     );
690
691   foreach my $page_num (1..$pdf->pages()) {
692     my $curpage  = $pdf->openpage($page_num);
693
694     if ($pdfopts->{number}) {
695       my $label    = $main::locale->text("Page #1/#2", $page_num, $pdf->pages());
696       my $text_obj = $curpage->text();
697
698       $text_obj->font($font, $font_size);
699       $text_obj->translate(($paper_width - $margin_left - $margin_right) / 2 + $margin_left - $text_obj->advancewidth($label) / 2, $margin_bottom);
700       $text_obj->text($label);
701     }
702
703     if ($opts->{title}) {
704       my $title    = $opts->{title};
705       my $text_obj = $curpage->text();
706
707       $text_obj->font($font, $title_font_size);
708       $text_obj->translate(($paper_width - $margin_left - $margin_right) / 2 + $margin_left - $text_obj->advancewidth($title) / 2,
709                            $paper_height - $margin_top);
710       $text_obj->text($title, '-underline' => 1);
711     }
712   }
713
714   my $content = $pdf->stringify();
715
716   $main::lxdebug->message(LXDebug->DEBUG2(),"addattachments ?? =".$form->{report_generator_addattachments}." GL=".$form->{GL});
717   if ($form->{report_generator_addattachments} && $form->{GL}) {
718     $content = $self->append_gl_pdf_attachments($form,$content);
719   }
720
721   my $printer_command;
722   if ($pdfopts->{print} && $pdfopts->{printer_id}) {
723     $form->{printer_id} = $pdfopts->{printer_id};
724     $form->get_printer_code($myconfig);
725     $printer_command = $form->{printer_command};
726   }
727
728   if ($printer_command) {
729     $self->_print_content('printer_command' => $printer_command,
730                           'content'         => $content,
731                           'copies'          => $pdfopts->{copies});
732     $form->{report_generator_printed} = 1;
733
734   } else {
735     my $filename = $self->get_attachment_basename();
736
737     print qq|content-type: application/pdf\n|;
738     print qq|content-disposition: attachment; filename=${filename}.pdf\n\n|;
739
740     $::locale->with_raw_io(\*STDOUT, sub {
741       print $content;
742     });
743   }
744 }
745
746 sub verify_paper_size {
747   my $self                 = shift;
748   my $requested_paper_size = lc shift;
749   my $default_paper_size   = shift;
750
751   my %allowed_paper_sizes  = map { $_ => 1 } qw(a3 a4 a5 letter legal);
752
753   return $allowed_paper_sizes{$requested_paper_size} ? $requested_paper_size : $default_paper_size;
754 }
755
756 sub _print_content {
757   my $self   = shift;
758   my %params = @_;
759
760   foreach my $i (1 .. max $params{copies}, 1) {
761     my $printer = IO::File->new("| $params{printer_command}");
762     $main::form->error($main::locale->text('Could not spawn the printer command.')) if (!$printer);
763     $printer->print($params{content});
764     $printer->close();
765   }
766 }
767
768 sub _handle_quoting_and_encoding {
769   my ($self, $text, $do_unquote, $encoding) = @_;
770
771   $text = $main::locale->unquote_special_chars('HTML', $text) if $do_unquote;
772   $text = Encode::encode($encoding || 'UTF-8', $text);
773
774   return $text;
775 }
776
777 sub generate_csv_content {
778   my $self   = shift;
779   my $stdout = ($::dispatcher->get_standard_filehandles)[1];
780
781   # Text::CSV_XS seems to downgrade to bytes already (see
782   # SL/FCGIFixes.pm). Therefore don't let FCGI do that again.
783   $::locale->with_raw_io($stdout, sub { $self->_generate_csv_content($stdout) });
784 }
785
786 sub _generate_csv_content {
787   my ($self, $stdout) = @_;
788
789   my %valid_sep_chars    = (';' => ';', ',' => ',', ':' => ':', 'TAB' => "\t");
790   my %valid_escape_chars = ('"' => 1, "'" => 1);
791   my %valid_quote_chars  = ('"' => 1, "'" => 1);
792
793   my $opts        = $self->{options}->{csv_export};
794   my $eol         = $opts->{eol_style} eq 'DOS'               ? "\r\n"                              : "\n";
795   my $sep_char    = $valid_sep_chars{$opts->{sep_char}}       ? $valid_sep_chars{$opts->{sep_char}} : ';';
796   my $escape_char = $valid_escape_chars{$opts->{escape_char}} ? $opts->{escape_char}                : '"';
797   my $quote_char  = $valid_quote_chars{$opts->{quote_char}}   ? $opts->{quote_char}                 : '"';
798
799   $escape_char    = $quote_char if ($opts->{escape_char} eq 'QUOTE_CHAR');
800
801   my $csv = Text::CSV_XS->new({ 'binary'      => 1,
802                                 'sep_char'    => $sep_char,
803                                 'escape_char' => $escape_char,
804                                 'quote_char'  => $quote_char,
805                                 'eol'         => $eol, });
806
807   my @visible_columns = $self->get_visible_columns('CSV');
808
809   if ($opts->{headers}) {
810     if (!$self->{custom_headers}) {
811       $csv->print($stdout, [ map { $self->_handle_quoting_and_encoding($self->{columns}->{$_}->{text}, 1, $opts->{encoding}) } @visible_columns ]);
812
813     } else {
814       foreach my $row (@{ $self->{custom_headers} }) {
815         my $fields = [ ];
816
817         foreach my $col (@{ $row }) {
818           my $num_output = ($col->{colspan} && ($col->{colspan} > 1)) ? $col->{colspan} : 1;
819           push @{ $fields }, ($self->_handle_quoting_and_encoding($col->{text}, 1, $opts->{encoding})) x $num_output;
820         }
821
822         $csv->print($stdout, $fields);
823       }
824     }
825   }
826
827   foreach my $row_set (@{ $self->{data} }) {
828     next if ('ARRAY' ne ref $row_set);
829     foreach my $row (@{ $row_set }) {
830       my @data;
831       my $skip_next = 0;
832       foreach my $col (@visible_columns) {
833         if ($skip_next) {
834           $skip_next--;
835           next;
836         }
837
838         my $num_output = ($row->{$col}{colspan} && ($row->{$col}->{colspan} > 1)) ? $row->{$col}->{colspan} : 1;
839         $skip_next     = $num_output - 1;
840
841         push @data, join($eol, map { s/\r?\n/$eol/g; $self->_handle_quoting_and_encoding($_, 0, $opts->{encoding}) } @{ $row->{$col}->{data} });
842         push @data, ('') x $skip_next if ($skip_next);
843       }
844
845       $csv->print($stdout, \@data);
846     }
847   }
848 }
849
850 sub check_for_pdf_api {
851   return eval { require PDF::API2; 1; } ? 1 : 0;
852 }
853
854 1;
855
856 __END__
857
858 =head1 NAME
859
860 SL::ReportGenerator.pm: the kivitendo way of getting data in shape
861
862 =head1 SYNOPSIS
863
864   my $report = SL::ReportGenerator->new(\%myconfig, $form);
865      $report->set_options(%options);                         # optional
866      $report->set_columns(%column_defs);
867      $report->set_sort_indicator($column, $direction);       # optional
868      $report->add_data($row1, $row2, @more_rows);
869      $report->generate_with_headers();
870
871 This creates a report object, sets a few columns, adds some data and generates a standard report.
872 Sorting of columns will be alphabetic, and options will be set to their defaults.
873 The report will be printed including table headers, html headers and http headers.
874
875 =head1 DESCRIPTION
876
877 Imagine the following scenario:
878 There's a simple form, which loads some data from the database, and needs to print it out. You write a template for it.
879 Then there may be more than one line. You add a loop in the template.
880 Then there are some options made by the user, such as hidden columns. You add more to the template.
881 Then it lacks usability. You want it to be able to sort the data. You add code for that.
882 Then there are too many results, you need pagination, you want to print or export that data..... and so on.
883
884 The ReportGenerator class was designed because this exact scenario happened about half a dozen times in kivitendo.
885 It's purpose is to manage all those formating, culling, sorting, and templating.
886 Which makes it almost as complicated to use as doing the work by yourself.
887
888 =head1 FUNCTIONS
889
890 =over 4
891
892 =item new \%myconfig,$form,%options
893
894 Creates a new ReportGenerator object, sets all given options, and returns it.
895
896 =item set_columns %columns
897
898 Sets the columns available to this report.
899
900 =item set_column_order @columns
901
902 Sets the order of columns. Any columns not present here are appended in alphabetic order.
903
904 =item set_sort_indicator $column,$direction
905
906 Sets sorting of the table by specifying a column and a direction, where the direction will be evaluated to ascending if true.
907 Note that this is only for displaying. The data has to have already been sorted when it was added.
908
909 =item add_data \@data
910
911 =item add_data \%data
912
913 Adds data to the report. A given hash_ref is interpreted as a single line of
914 data, every array_ref as a collection of lines.  Every line will be expected to
915 be in a key => value format. Note that the rows have to already have been
916 sorted.
917
918 The ReportGenerator is only able to display pre-sorted data and to indicate by
919 which column and in which direction the data has been sorted via visual clues
920 in the column headers. It also provides links to invert the sort direction.
921
922 =item add_separator
923
924 Adds a separator line to the report.
925
926 =item add_control \%data
927
928 Adds a control element to the data. Control elements are an experimental feature to add functionality to a report the regular data cannot.
929 Every control element needs to set IS_CONTROL_DATA, in order to be recognized by the template.
930 Currently the only control element is a colspan element, which can be used as a mini header further down the report.
931
932 =item clear_data
933
934 Deletes all data added to the report, but keeps options set.
935
936 =item set_options %options
937
938 Sets options. For an incomplete list of options, see section configuration.
939
940 =item set_options_from_form
941
942 Tries to import options from the $form object given at creation
943
944 =item set_export_options $next_sub,@variable_list
945
946 Sets next_sub and additional variables needed for export.
947
948 =item get_attachment_basename
949
950 Returns the set attachment_basename option, or 'report' if nothing was set. See configuration for the option.
951
952 =item generate_with_headers
953
954 Parses the report, adds headers and prints it out. Headers depend on the option 'output_format',
955 for example 'HTML' will add proper table headers, html headers and http headers. See configuration for this option.
956
957 =item get_visible_columns $format
958
959 Returns a list of columns that will be visible in the report after considering all options or match the given format.
960
961 =item html_format $value
962
963 Escapes HTML characters in $value and substitutes newlines with '<br>'. Returns the escaped $value.
964
965 =item prepare_html_content $column,$name,@column_headers
966
967 Parses the data, and sets internal data needed for certain output format. Must be called once before the template is invoked.
968 Should not be called externally, since all render and generate functions invoke it anyway.
969
970 =item generate_html_content
971
972 The html generation function. Is invoked by generate_with_headers.
973
974 =item generate_pdf_content
975
976 The PDF generation function. It is invoked by generate_with_headers and renders the PDF with the PDF::API2 library.
977
978 =item generate_csv_content
979
980 The CSV generation function. Uses XS_CSV to parse the information into csv.
981
982 =back
983
984 =head1 CONFIGURATION
985
986 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.
987
988 =head2 General Options
989
990 =over 4
991
992 =item std_column_visibility
993
994 Standard column visibility. Used if no visibility is set. Use this to save the trouble of enabling every column. Default is no.
995
996 =item output_format
997
998 Output format. Used by generate_with_headers to determine the format. Supported options are HTML, CSV, and PDF. Default is HTML.
999
1000 =item allow_pdf_export
1001
1002 Used to determine if a button for PDF export should be displayed. Default is yes.
1003
1004 =item allow_csv_export
1005
1006 Used to determine if a button for CSV export should be displayed. Default is yes.
1007
1008 =item html_template
1009
1010 The template to be used for HTML reports. Default is 'report_generator/html_report'.
1011
1012 =item controller_class
1013
1014 If this is used from a C<SL::Controller::Base> based controller class, pass the
1015 class name here and make sure C<SL::Controller::Helper::ReportGenerator> is
1016 used in the controller. That way the exports stay functional.
1017
1018 =back
1019
1020 =head2 PDF Options
1021
1022 =over 4
1023
1024 =item paper_size
1025
1026 Paper size. Default is a4. Supported paper sizes are a3, a4, a5, letter and legal.
1027
1028 =item orientation (landscape)
1029
1030 Landscape or portrait. Default is landscape.
1031
1032 =item font_name
1033
1034 Default is Verdana. Supported font names are Courier, Georgia, Helvetica, Times and Verdana. This option only affects the rendering with PDF::API2.
1035
1036 =item font_size
1037
1038 Default is 7. This option only affects the rendering with PDF::API2.
1039
1040 =item margin_top
1041
1042 =item margin_left
1043
1044 =item margin_bottom
1045
1046 =item margin_right
1047
1048 The paper margins in cm. They all default to 1.5.
1049
1050 =item number
1051
1052 Set to a true value if the pages should be numbered. Default is 1.
1053
1054 =item print
1055
1056 If set then the resulting PDF will be output to a printer. If not it will be downloaded by the user. Default is no.
1057
1058 =item printer_id
1059
1060 Default 0.
1061
1062 =item copies
1063
1064 Default 1.
1065
1066 =back
1067
1068 =head2 CSV Options
1069
1070 =over 4
1071
1072 =item quote_char
1073
1074 Character to enclose entries. Default is double quote (").
1075
1076 =item sep_char
1077
1078 Character to separate entries. Default is semicolon (;).
1079
1080 =item escape_char
1081
1082 Character to escape the quote_char. Default is double quote (").
1083
1084 =item eol_style
1085
1086 End of line style. Default is Unix.
1087
1088 =item headers
1089
1090 Include headers? Default is yes.
1091
1092 =item encoding
1093
1094 Character encoding. Default is UTF-8.
1095
1096 =back
1097
1098 =head1 SEE ALO
1099
1100 C<Template.pm>
1101
1102 =head1 MODULE AUTHORS
1103
1104 Moritz Bunkus E<lt>mbunkus@linet-services.deE<gt>
1105
1106 L<http://linet-services.de>