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