Projekt

Allgemein

Profil

Herunterladen (35,7 KB) Statistiken
| Zweig: | Markierung: | Revision:
a939b727 Moritz Bunkus
package SL::ReportGenerator;

86330615 Sven Schöling
use Data::Dumper;
49f0957f Moritz Bunkus
use List::Util qw(max);
40e0911a Moritz Bunkus
use Scalar::Util qw(blessed);
a939b727 Moritz Bunkus
use Text::CSV_XS;
ea707efc Sven Schöling
#use PDF::API2; # these two eat up to .75s on startup. only load them if we actually need them
#use PDF::Table;
a939b727 Moritz Bunkus
76c486e3 Sven Schöling
use strict;
fd2e0902 Martin Helmling
use SL::Helper::GlAttachments qw(append_gl_pdf_attachments);
use SL::Helper::CreatePDF qw(merge_pdfs);
22ab10f7 Bernd Bleßmann
use SL::JSON qw(to_json);
76c486e3 Sven Schöling
6f205006 Moritz Bunkus
# Cause locales.pl to parse these files:
# parse_html_template('report_generator/html_report')

a939b727 Moritz Bunkus
sub new {
my $type = shift;

my $self = { };

$self->{myconfig} = shift;
$self->{form} = shift;

$self->{data} = [];
$self->{options} = {
'std_column_visibility' => 0,
'output_format' => 'HTML',
1320854c Sven Schöling
'controller_class ' => '',
a939b727 Moritz Bunkus
'allow_pdf_export' => 1,
'allow_csv_export' => 1,
22ab10f7 Bernd Bleßmann
'allow_chart_export' => 1,
6f205006 Moritz Bunkus
'html_template' => 'report_generator/html_report',
a939b727 Moritz Bunkus
'pdf_export' => {
42b702a6 Moritz Bunkus
'paper_size' => 'a4',
a939b727 Moritz Bunkus
'orientation' => 'landscape',
42b702a6 Moritz Bunkus
'font_name' => 'Verdana',
'font_size' => '7',
a939b727 Moritz Bunkus
'margin_top' => 1.5,
'margin_left' => 1.5,
'margin_bottom' => 1.5,
'margin_right' => 1.5,
'number' => 1,
49f0957f Moritz Bunkus
'print' => 0,
'printer_id' => 0,
'copies' => 1,
a939b727 Moritz Bunkus
},
'csv_export' => {
'quote_char' => '"',
'sep_char' => ';',
'escape_char' => '"',
9f7dadd9 Moritz Bunkus
'eol_style' => 'Unix',
a939b727 Moritz Bunkus
'headers' => 1,
d9ab23fa Bernd Bleßmann
'encoding' => 'UTF-8',
a939b727 Moritz Bunkus
},
22ab10f7 Bernd Bleßmann
'chart_export' => {
b77889e1 Bernd Bleßmann
'assignment_x' => '',
'assignments_y' => [],
22ab10f7 Bernd Bleßmann
},
a939b727 Moritz Bunkus
};
$self->{export} = {
'nextsub' => '',
baba1fe9 Moritz Bunkus
'variable_list' => [],
a939b727 Moritz Bunkus
};

43c22d1c Moritz Bunkus
$self->{data_present} = 0;

0eb1af1c Moritz Bunkus
bless $self, $type;

a939b727 Moritz Bunkus
$self->set_options(@_) if (@_);

0eb1af1c Moritz Bunkus
return $self;
a939b727 Moritz Bunkus
}

sub set_columns {
my $self = shift;
my %columns = @_;

$self->{columns} = \%columns;

foreach my $column (values %{ $self->{columns} }) {
$column->{visible} = $self->{options}->{std_column_visibility} unless defined $column->{visible};
}
ca5da06d Sven Schöling
0185267e Thomas Heck
if( $::form->{report_generator_csv_options_for_import} ) {
foreach my $key (keys %{ $self->{columns} }) {
$self->{columns}{$key}{text} = $key;
}
}
a939b727 Moritz Bunkus
$self->set_column_order(sort keys %{ $self->{columns} });
}

sub set_column_order {
my $self = shift;
ee5d63a6 Sven Schöling
my %seen;
$self->{column_order} = [ grep { !$seen{$_}++ } @_, sort keys %{ $self->{columns} } ];
a939b727 Moritz Bunkus
}

sub set_sort_indicator {
my $self = shift;

$self->{options}->{sort_indicator_column} = shift;
$self->{options}->{sort_indicator_direction} = shift;
}

sub add_data {
my $self = shift;

24e8b084 Moritz Bunkus
my $last_row_set;

a939b727 Moritz Bunkus
while (my $arg = shift) {
27bdd44b Moritz Bunkus
my $row_set;

a939b727 Moritz Bunkus
if ('ARRAY' eq ref $arg) {
27bdd44b Moritz Bunkus
$row_set = $arg;
a939b727 Moritz Bunkus
} elsif ('HASH' eq ref $arg) {
27bdd44b Moritz Bunkus
$row_set = [ $arg ];
a939b727 Moritz Bunkus
} else {
$self->{form}->error('Incorrect usage -- expecting hash or array ref');
}
27bdd44b Moritz Bunkus
dba493ac Moritz Bunkus
my @columns_with_default_alignment = grep { defined $self->{columns}->{$_}->{align} } keys %{ $self->{columns} };

27bdd44b Moritz Bunkus
foreach my $row (@{ $row_set }) {
dba493ac Moritz Bunkus
foreach my $column (@columns_with_default_alignment) {
$row->{$column} ||= { };
$row->{$column}->{align} = $self->{columns}->{$column}->{align} unless (defined $row->{$column}->{align});
}

1e987ead Moritz Bunkus
foreach my $field (qw(data link link_class)) {
27bdd44b Moritz Bunkus
map { $row->{$_}->{$field} = [ $row->{$_}->{$field} ] if (ref $row->{$_}->{$field} ne 'ARRAY') } keys %{ $row };
}
}

push @{ $self->{data} }, $row_set;
$last_row_set = $row_set;
43c22d1c Moritz Bunkus
$self->{data_present} = 1;
a939b727 Moritz Bunkus
}
24e8b084 Moritz Bunkus
return $last_row_set;
}

sub add_separator {
my $self = shift;

push @{ $self->{data} }, { 'type' => 'separator' };
a939b727 Moritz Bunkus
}

971ca389 Moritz Bunkus
sub add_control {
my $self = shift;
my $data = shift;

push @{ $self->{data} }, $data;
}

a939b727 Moritz Bunkus
sub clear_data {
my $self = shift;

43c22d1c Moritz Bunkus
$self->{data} = [];
$self->{data_present} = 0;
a939b727 Moritz Bunkus
}

sub set_options {
my $self = shift;
my %options = @_;

42b702a6 Moritz Bunkus
while (my ($key, $value) = each %options) {
if ($key eq 'pdf_export') {
70df0cd4 Bernd Bleßmann
$self->{options}->{pdf_export}->{$_} = $value->{$_} for keys %{ $value };
61908307 Bernd Bleßmann
} elsif ($key eq 'csv_export') {
$self->{options}->{csv_export}->{$_} = $value->{$_} for keys %{ $value };
22ab10f7 Bernd Bleßmann
} elsif ($key eq 'chart_export') {
$self->{options}->{chart_export}->{$_} = $value->{$_} for keys %{ $value };
42b702a6 Moritz Bunkus
} else {
$self->{options}->{$key} = $value;
}
}
a939b727 Moritz Bunkus
}

sub set_options_from_form {
my $self = shift;

my $form = $self->{form};
my $myconfig = $self->{myconfig};

foreach my $key (qw(output_format)) {
my $full_key = "report_generator_${key}";
$self->{options}->{$key} = $form->{$full_key} if (defined $form->{$full_key});
}

22ab10f7 Bernd Bleßmann
foreach my $format (qw(pdf csv chart)) {
a939b727 Moritz Bunkus
my $opts = $self->{options}->{"${format}_export"};
foreach my $key (keys %{ $opts }) {
my $full_key = "report_generator_${format}_options_${key}";
$opts->{$key} = $key =~ /^margin/ ? $form->parse_amount($myconfig, $form->{$full_key}) : $form->{$full_key};
}
}
}

sub set_export_options {
my $self = shift;

$self->{export} = {
'nextsub' => shift,
baba1fe9 Moritz Bunkus
'variable_list' => [ @_ ],
a939b727 Moritz Bunkus
};
}

84ba8214 Moritz Bunkus
sub set_custom_headers {
my $self = shift;

if (@_) {
$self->{custom_headers} = [ @_ ];
} else {
delete $self->{custom_headers};
}
}

ecb5cd9f Moritz Bunkus
sub get_attachment_basename {
my $self = shift;
my $filename = $self->{options}->{attachment_basename} || 'report';
f5f3c1a7 Sven Schöling
# FIXME: this is bonkers. add a real sluggify method somewhere or import one.
ecb5cd9f Moritz Bunkus
$filename =~ s|.*\\||;
$filename =~ s|.*/||;
f5f3c1a7 Sven Schöling
$filename =~ s| |_|g;
ecb5cd9f Moritz Bunkus
return $filename;
}

a939b727 Moritz Bunkus
sub generate_with_headers {
ca5da06d Sven Schöling
my ($self, %params) = @_;
a939b727 Moritz Bunkus
my $format = lc $self->{options}->{output_format};
f0ce00eb Moritz Bunkus
my $form = $self->{form};
a939b727 Moritz Bunkus
if (!$self->{columns}) {
f0ce00eb Moritz Bunkus
$form->error('Incorrect usage -- no columns specified');
a939b727 Moritz Bunkus
}

if ($format eq 'html') {
40e0911a Moritz Bunkus
my $content = $self->generate_html_content(%params);
f0ce00eb Moritz Bunkus
my $title = $form->{title};
$form->{title} = $self->{title} if ($self->{title});
ca5da06d Sven Schöling
$form->header(no_layout => $params{no_layout});
f0ce00eb Moritz Bunkus
$form->{title} = $title;

40e0911a Moritz Bunkus
print $content;
a939b727 Moritz Bunkus
} elsif ($format eq 'csv') {
f5f3c1a7 Sven Schöling
# FIXME: don't do mini http in here
ecb5cd9f Moritz Bunkus
my $filename = $self->get_attachment_basename();
15b4d5a3 Moritz Bunkus
print qq|content-type: text/csv\n|;
print qq|content-disposition: attachment; filename=${filename}.csv\n\n|;
cc042e07 Sven Schöling
$::locale->with_raw_io(\*STDOUT, sub {
$self->generate_csv_content();
});
a939b727 Moritz Bunkus
} elsif ($format eq 'pdf') {
$self->generate_pdf_content();

22ab10f7 Bernd Bleßmann
} elsif ($format eq 'chart') {
$self->generate_chart_content();

a939b727 Moritz Bunkus
} else {
22ab10f7 Bernd Bleßmann
$form->error('Incorrect usage -- unknown format (supported are HTML, CSV, PDF, Chart)');
a939b727 Moritz Bunkus
}
}

sub get_visible_columns {
my $self = shift;
my $format = shift;

5cf977e5 Moritz Bunkus
return grep { my $c = $self->{columns}->{$_}; $c && $c->{visible} && (($c->{visible} == 1) || ($c->{visible} =~ /\Q${format}\E/i)) } @{ $self->{column_order} };
a939b727 Moritz Bunkus
}

15b4d5a3 Moritz Bunkus
sub html_format {
my $self = shift;
my $value = shift;

dc3cd296 Moritz Bunkus
$value = $main::locale->quote_special_chars('HTML', $value);
15b4d5a3 Moritz Bunkus
$value =~ s/\r//g;
$value =~ s/\n/<br>/g;

return $value;
}

a939b727 Moritz Bunkus
sub prepare_html_content {
40e0911a Moritz Bunkus
my ($self, %params) = @_;
a939b727 Moritz Bunkus
my ($column, $name, @column_headers);

my $opts = $self->{options};
my @visible_columns = $self->get_visible_columns('HTML');

foreach $name (@visible_columns) {
$column = $self->{columns}->{$name};

my $header = {
'name' => $name,
10090774 Moritz Bunkus
'align' => $column->{align},
a939b727 Moritz Bunkus
'link' => $column->{link},
'text' => $column->{text},
97eb7f68 Moritz Bunkus
'raw_header_data' => $column->{raw_header_data},
a939b727 Moritz Bunkus
'show_sort_indicator' => $name eq $opts->{sort_indicator_column},
'sort_indicator_direction' => $opts->{sort_indicator_direction},
};

push @column_headers, $header;
}

84ba8214 Moritz Bunkus
my $header_rows;
if ($self->{custom_headers}) {
$header_rows = $self->{custom_headers};
} else {
$header_rows = [ \@column_headers ];
}

a939b727 Moritz Bunkus
my ($outer_idx, $inner_idx) = (0, 0);
66e5ad7b Moritz Bunkus
my $next_border_top;
a939b727 Moritz Bunkus
my @rows;

foreach my $row_set (@{ $self->{data} }) {
24e8b084 Moritz Bunkus
if ('HASH' eq ref $row_set) {
66e5ad7b Moritz Bunkus
if ($row_set->{type} eq 'separator') {
if (! scalar @rows) {
$next_border_top = 1;
} else {
$rows[-1]->{BORDER_BOTTOM} = 1;
}

next;
}

24e8b084 Moritz Bunkus
my $row_data = {
971ca389 Moritz Bunkus
'IS_CONTROL' => 1,
'IS_COLSPAN_DATA' => $row_set->{type} eq 'colspan_data',
'NUM_COLUMNS' => scalar @visible_columns,
66e5ad7b Moritz Bunkus
'BORDER_TOP' => $next_border_top,
971ca389 Moritz Bunkus
'data' => $row_set->{data},
24e8b084 Moritz Bunkus
};

push @rows, $row_data;

66e5ad7b Moritz Bunkus
$next_border_top = 0;

24e8b084 Moritz Bunkus
next;
}

a939b727 Moritz Bunkus
$outer_idx++;

foreach my $row (@{ $row_set }) {
$inner_idx++;

078fa02a Moritz Bunkus
my $output_columns = [ ];
my $skip_next = 0;
27bdd44b Moritz Bunkus
foreach my $col_name (@visible_columns) {
078fa02a Moritz Bunkus
if ($skip_next) {
$skip_next--;
next;
}

86330615 Sven Schöling
my $col = $row->{$col_name} || { data => [] };
27bdd44b Moritz Bunkus
$col->{CELL_ROWS} = [ ];
bf3cc4b6 Moritz Bunkus
foreach my $i (0 .. scalar(@{ $col->{data} }) - 1) {
27bdd44b Moritz Bunkus
push @{ $col->{CELL_ROWS} }, {
8836016b Moritz Bunkus
'data' => '' . $self->html_format($col->{data}->[$i]),
27bdd44b Moritz Bunkus
'link' => $col->{link}->[$i],
1e987ead Moritz Bunkus
link_class => $col->{link_class}->[$i],
27bdd44b Moritz Bunkus
};
86e5dc50 Moritz Bunkus
}

# Force at least a &nbsp; to be displayed so that browsers
# will format the table cell (e.g. borders etc).
if (!scalar @{ $col->{CELL_ROWS} }) {
push @{ $col->{CELL_ROWS} }, { 'data' => '&nbsp;' };
943901c1 Moritz Bunkus
} elsif ((1 == scalar @{ $col->{CELL_ROWS} }) && (!defined $col->{CELL_ROWS}->[0]->{data} || ($col->{CELL_ROWS}->[0]->{data} eq ''))) {
86e5dc50 Moritz Bunkus
$col->{CELL_ROWS}->[0]->{data} = '&nbsp;';
}
078fa02a Moritz Bunkus
push @{ $output_columns }, $col;
$skip_next = $col->{colspan} ? $col->{colspan} - 1 : 0;
27bdd44b Moritz Bunkus
}
15b4d5a3 Moritz Bunkus
a939b727 Moritz Bunkus
my $row_data = {
078fa02a Moritz Bunkus
'COLUMNS' => $output_columns,
a939b727 Moritz Bunkus
'outer_idx' => $outer_idx,
'outer_idx_odd' => $outer_idx % 2,
'inner_idx' => $inner_idx,
66e5ad7b Moritz Bunkus
'BORDER_TOP' => $next_border_top,
a939b727 Moritz Bunkus
};

push @rows, $row_data;
66e5ad7b Moritz Bunkus
$next_border_top = 0;
a939b727 Moritz Bunkus
}
}

baba1fe9 Moritz Bunkus
my @export_variables = $self->{form}->flatten_variables(@{ $self->{export}->{variable_list} });
a939b727 Moritz Bunkus
d33ad436 Moritz Bunkus
my $allow_pdf_export = $opts->{allow_pdf_export};
a939b727 Moritz Bunkus
my $variables = {
'TITLE' => $opts->{title},
15b4d5a3 Moritz Bunkus
'TOP_INFO_TEXT' => $self->html_format($opts->{top_info_text}),
a939b727 Moritz Bunkus
'RAW_TOP_INFO_TEXT' => $opts->{raw_top_info_text},
15b4d5a3 Moritz Bunkus
'BOTTOM_INFO_TEXT' => $self->html_format($opts->{bottom_info_text}),
a939b727 Moritz Bunkus
'RAW_BOTTOM_INFO_TEXT' => $opts->{raw_bottom_info_text},
'ALLOW_PDF_EXPORT' => $allow_pdf_export,
'ALLOW_CSV_EXPORT' => $opts->{allow_csv_export},
22ab10f7 Bernd Bleßmann
'ALLOW_CHART_EXPORT' => $opts->{allow_chart_export},
'SHOW_EXPORT_BUTTONS' => ($allow_pdf_export || $opts->{allow_csv_export} || $opts->{allow_chart_export}) && $self->{data_present},
84ba8214 Moritz Bunkus
'HEADER_ROWS' => $header_rows,
a939b727 Moritz Bunkus
'NUM_COLUMNS' => scalar @column_headers,
'ROWS' => \@rows,
'EXPORT_VARIABLES' => \@export_variables,
baba1fe9 Moritz Bunkus
'EXPORT_VARIABLE_LIST' => join(' ', @{ $self->{export}->{variable_list} }),
a939b727 Moritz Bunkus
'EXPORT_NEXTSUB' => $self->{export}->{nextsub},
43c22d1c Moritz Bunkus
'DATA_PRESENT' => $self->{data_present},
1320854c Sven Schöling
'CONTROLLER_DISPATCH' => $opts->{controller_class},
db3b23aa Sven Schöling
'TABLE_CLASS' => $opts->{table_class},
40e0911a Moritz Bunkus
'SKIP_BUTTONS' => !!$params{action_bar},
a939b727 Moritz Bunkus
};

return $variables;
}

76a39ab4 Moritz Bunkus
sub create_action_bar_actions {
b3ef51de Tamino Steinert
my ($self, $variables, %params) = @_;
40e0911a Moritz Bunkus
my @actions;
22ab10f7 Bernd Bleßmann
foreach my $type (qw(pdf csv chart)) {
40e0911a Moritz Bunkus
next unless $variables->{"ALLOW_" . uc($type) . "_EXPORT"};

my $key = $variables->{CONTROLLER_DISPATCH} ? 'action' : 'report_generator_dispatch_to';
my $value = "report_generator_export_as_${type}";
$value = $variables->{CONTROLLER_DISPATCH} . "/${value}" if $variables->{CONTROLLER_DISPATCH};

push @actions, action => [
22ab10f7 Bernd Bleßmann
$type eq 'pdf' ? $::locale->text('PDF export') : $type eq 'csv' ? $::locale->text('CSV export') : $::locale->text('Chart export'),
b3ef51de Tamino Steinert
submit => [ '#report_generator_form', {(
$key => $value,
defined $params{action_bar_additional_submit_values}
? %{$params{action_bar_additional_submit_values}}
: undef
)} ],
40e0911a Moritz Bunkus
];
}

if (scalar(@actions) > 1) {
@actions = (
combobox => [
action => [ $::locale->text('Export') ],
@actions,
],
);
}

76a39ab4 Moritz Bunkus
return @actions;
}

sub setup_action_bar {
my ($self, $variables, %params) = @_;

b3ef51de Tamino Steinert
my @actions = $self->create_action_bar_actions($variables, %params);
76a39ab4 Moritz Bunkus
if ($params{action_bar_setup_hook}) {
$params{action_bar_setup_hook}->(@actions);

} elsif (@actions) {
my $action_bar = blessed($params{action_bar}) ? $params{action_bar} : ($::request->layout->get('actionbar'))[0];
$action_bar->add(@actions);
}
40e0911a Moritz Bunkus
}

a939b727 Moritz Bunkus
sub generate_html_content {
40e0911a Moritz Bunkus
my ($self, %params) = @_;
e7913c4c Moritz Bunkus
$params{action_bar} //= 1;

40e0911a Moritz Bunkus
my $variables = $self->prepare_html_content(%params);
76a39ab4 Moritz Bunkus
$self->setup_action_bar($variables, %params) if $params{action_bar};
6f205006 Moritz Bunkus
ca5da06d Sven Schöling
my $stuff = $self->{form}->parse_html_template($self->{options}->{html_template}, $variables);
return $stuff;
a939b727 Moritz Bunkus
}

42b702a6 Moritz Bunkus
sub _cm2bp {
# 1 bp = 1/72 in
# 1 in = 2.54 cm
return $_[0] * 72 / 2.54;
}

786b3862 Moritz Bunkus
sub generate_pdf_content {
eval {
require PDF::API2;
require PDF::Table;
};

42b702a6 Moritz Bunkus
my $self = shift;
078bf25d Jan Büren
my %params = @_;
42b702a6 Moritz Bunkus
my $variables = $self->prepare_html_content();
my $form = $self->{form};
my $myconfig = $self->{myconfig};

my $opts = $self->{options};
222bbfe9 Moritz Bunkus
my $pdfopts = $opts->{pdf_export};
42b702a6 Moritz Bunkus
my (@data, @column_props, @cell_props);

84ba8214 Moritz Bunkus
my ($data_row, $cell_props_row);
9bfcf6a0 Moritz Bunkus
my @visible_columns = $self->get_visible_columns('PDF');
84ba8214 Moritz Bunkus
my $num_columns = scalar @visible_columns;
my $num_header_rows = 1;
42b702a6 Moritz Bunkus
dbda14c2 Moritz Bunkus
my $font_encoding = 'UTF-8';
389007ac Moritz Bunkus
ea707efc Sven Schöling
foreach my $name (@visible_columns) {
84ba8214 Moritz Bunkus
push @column_props, { 'justify' => $self->{columns}->{$name}->{align} eq 'right' ? 'right' : 'left' };
42b702a6 Moritz Bunkus
}

84ba8214 Moritz Bunkus
if (!$self->{custom_headers}) {
$data_row = [];
$cell_props_row = [];
push @data, $data_row;
push @cell_props, $cell_props_row;

ea707efc Sven Schöling
foreach my $name (@visible_columns) {
my $column = $self->{columns}->{$name};
84ba8214 Moritz Bunkus
cc042e07 Sven Schöling
push @{ $data_row }, $column->{text};
84ba8214 Moritz Bunkus
push @{ $cell_props_row }, {};
}
42b702a6 Moritz Bunkus
84ba8214 Moritz Bunkus
} else {
$num_header_rows = scalar @{ $self->{custom_headers} };

foreach my $custom_header_row (@{ $self->{custom_headers} }) {
$data_row = [];
$cell_props_row = [];
push @data, $data_row;
push @cell_props, $cell_props_row;

foreach my $custom_header_col (@{ $custom_header_row }) {
cc042e07 Sven Schöling
push @{ $data_row }, $custom_header_col->{text};
7d42d369 Moritz Bunkus
my $num_output = ($custom_header_col->{colspan} * 1 > 1) ? $custom_header_col->{colspan} : 1;
if ($num_output > 1) {
push @{ $data_row }, ('') x ($num_output - 1);
push @{ $cell_props_row }, { 'colspan' => $num_output };
push @{ $cell_props_row }, ({ }) x ($num_output - 1);

} else {
push @{ $cell_props_row }, {};
}
84ba8214 Moritz Bunkus
}
}
}
42b702a6 Moritz Bunkus
foreach my $row_set (@{ $self->{data} }) {
if ('HASH' eq ref $row_set) {
if ($row_set->{type} eq 'colspan_data') {
cc042e07 Sven Schöling
push @data, [ $row_set->{data} ];
42b702a6 Moritz Bunkus
$cell_props_row = [];
push @cell_props, $cell_props_row;

foreach (0 .. $num_columns - 1) {
d3897394 Moritz Bunkus
push @{ $cell_props_row }, { 'background_color' => '#666666',
8172364e Martin Helmling
# BUG PDF:Table -> 0.9.12:
# font_color is used in next row, so dont set font_color
# 'font_color' => '#ffffff',
d3897394 Moritz Bunkus
'colspan' => $_ == 0 ? -1 : undef, };
42b702a6 Moritz Bunkus
}
}
next;
}

foreach my $row (@{ $row_set }) {
7d42d369 Moritz Bunkus
$data_row = [];
$cell_props_row = [];

push @data, $data_row;
push @cell_props, $cell_props_row;
42b702a6 Moritz Bunkus
my $col_idx = 0;
foreach my $col_name (@visible_columns) {
my $col = $row->{$col_name};
cc042e07 Sven Schöling
push @{ $data_row }, join("\n", @{ $col->{data} || [] });
42b702a6 Moritz Bunkus
$column_props[$col_idx]->{justify} = 'right' if ($col->{align} eq 'right');

7d42d369 Moritz Bunkus
my $cell_props = { };
push @{ $cell_props_row }, $cell_props;
42b702a6 Moritz Bunkus
7d42d369 Moritz Bunkus
if ($col->{colspan} && $col->{colspan} > 1) {
$cell_props->{colspan} = $col->{colspan};
}
42b702a6 Moritz Bunkus
7d42d369 Moritz Bunkus
$col_idx++;
42b702a6 Moritz Bunkus
}
}
}

foreach my $i (0 .. scalar(@data) - 1) {
my $aref = $data[$i];
my $num_columns_here = scalar @{ $aref };

if ($num_columns_here < $num_columns) {
push @{ $aref }, ('') x ($num_columns - $num_columns_here);
} elsif ($num_columns_here > $num_columns) {
splice @{ $aref }, $num_columns;
}
}

my $papersizes = {
'a3' => [ 842, 1190 ],
'a4' => [ 595, 842 ],
'a5' => [ 420, 595 ],
'letter' => [ 612, 792 ],
'legal' => [ 612, 1008 ],
};

my %supported_fonts = map { $_ => 1 } qw(courier georgia helvetica times verdana);

222bbfe9 Moritz Bunkus
my $paper_size = defined $pdfopts->{paper_size} && defined $papersizes->{lc $pdfopts->{paper_size}} ? lc $pdfopts->{paper_size} : 'a4';
42b702a6 Moritz Bunkus
my ($paper_width, $paper_height);

222bbfe9 Moritz Bunkus
if (lc $pdfopts->{orientation} eq 'landscape') {
42b702a6 Moritz Bunkus
($paper_width, $paper_height) = @{$papersizes->{$paper_size}}[1, 0];
} else {
($paper_width, $paper_height) = @{$papersizes->{$paper_size}}[0, 1];
}

222bbfe9 Moritz Bunkus
my $margin_top = _cm2bp($pdfopts->{margin_top} || 1.5);
my $margin_bottom = _cm2bp($pdfopts->{margin_bottom} || 1.5);
my $margin_left = _cm2bp($pdfopts->{margin_left} || 1.5);
my $margin_right = _cm2bp($pdfopts->{margin_right} || 1.5);
42b702a6 Moritz Bunkus
my $table = PDF::Table->new();
my $pdf = PDF::API2->new();
my $page = $pdf->page();

$pdf->mediabox($paper_width, $paper_height);

222bbfe9 Moritz Bunkus
my $font = $pdf->corefont(defined $pdfopts->{font_name} && $supported_fonts{lc $pdfopts->{font_name}} ? ucfirst $pdfopts->{font_name} : 'Verdana',
389007ac Moritz Bunkus
'-encoding' => $font_encoding);
222bbfe9 Moritz Bunkus
my $font_size = $pdfopts->{font_size} || 7;
42b702a6 Moritz Bunkus
my $title_font_size = $font_size + 1;
my $padding = 1;
my $font_height = $font_size + 2 * $padding;
my $title_font_height = $font_size + 2 * $padding;

74fca575 Sven Schöling
my $header_height = $opts->{title} ? 2 * $title_font_height : undef;
my $footer_height = $pdfopts->{number} ? 2 * $font_height : undef;
42b702a6 Moritz Bunkus
my $top_text_height = 0;

if ($self->{options}->{top_info_text}) {
cc042e07 Sven Schöling
my $top_text = $self->{options}->{top_info_text};
42b702a6 Moritz Bunkus
$top_text =~ s/\r//g;
$top_text =~ s/\n+$//;

my @lines = split m/\n/, $top_text;
$top_text_height = $font_height * scalar @lines;

foreach my $line_no (0 .. scalar(@lines) - 1) {
my $y_pos = $paper_height - $margin_top - $header_height - $line_no * $font_height;
my $text_obj = $page->text();

$text_obj->font($font, $font_size);
$text_obj->translate($margin_left, $y_pos);
$text_obj->text($lines[$line_no]);
}
}

$table->table($pdf,
$page,
\@data,
'x' => $margin_left,
'w' => $paper_width - $margin_left - $margin_right,
'start_y' => $paper_height - $margin_top - $header_height - $top_text_height,
'next_y' => $paper_height - $margin_top - $header_height,
'start_h' => $paper_height - $margin_top - $margin_bottom - $header_height - $footer_height - $top_text_height,
'next_h' => $paper_height - $margin_top - $margin_bottom - $header_height - $footer_height,
'padding' => 1,
'background_color_odd' => '#ffffff',
'background_color_even' => '#eeeeee',
'font' => $font,
'font_size' => $font_size,
'font_color' => '#000000',
84ba8214 Moritz Bunkus
'num_header_rows' => $num_header_rows,
42b702a6 Moritz Bunkus
'header_props' => {
'bg_color' => '#ffffff',
'repeat' => 1,
'font_color' => '#000000',
},
'column_props' => \@column_props,
'cell_props' => \@cell_props,
8948c9c6 Moritz Bunkus
'max_word_length' => 60,
33244697 Moritz Bunkus
'border' => 0.5,
42b702a6 Moritz Bunkus
);

foreach my $page_num (1..$pdf->pages()) {
my $curpage = $pdf->openpage($page_num);

222bbfe9 Moritz Bunkus
if ($pdfopts->{number}) {
cc042e07 Sven Schöling
my $label = $main::locale->text("Page #1/#2", $page_num, $pdf->pages());
42b702a6 Moritz Bunkus
my $text_obj = $curpage->text();

$text_obj->font($font, $font_size);
$text_obj->translate(($paper_width - $margin_left - $margin_right) / 2 + $margin_left - $text_obj->advancewidth($label) / 2, $margin_bottom);
$text_obj->text($label);
}

if ($opts->{title}) {
cc042e07 Sven Schöling
my $title = $opts->{title};
42b702a6 Moritz Bunkus
my $text_obj = $curpage->text();

$text_obj->font($font, $title_font_size);
389007ac Moritz Bunkus
$text_obj->translate(($paper_width - $margin_left - $margin_right) / 2 + $margin_left - $text_obj->advancewidth($title) / 2,
42b702a6 Moritz Bunkus
$paper_height - $margin_top);
389007ac Moritz Bunkus
$text_obj->text($title, '-underline' => 1);
42b702a6 Moritz Bunkus
}
}

7f7cbb08 Moritz Bunkus
my $content = $pdf->stringify();
42b702a6 Moritz Bunkus
fd2e0902 Martin Helmling
$main::lxdebug->message(LXDebug->DEBUG2(),"addattachments ?? =".$form->{report_generator_addattachments}." GL=".$form->{GL});
40e0911a Moritz Bunkus
if ($form->{report_generator_addattachments} && $form->{GL}) {
fd2e0902 Martin Helmling
$content = $self->append_gl_pdf_attachments($form,$content);
}

078bf25d Jan Büren
# 1. check if we return the report as binary pdf
if ($params{want_binary_pdf}) {
return $content;
}
# 2. check if we want and can directly print the report
7f7cbb08 Moritz Bunkus
my $printer_command;
222bbfe9 Moritz Bunkus
if ($pdfopts->{print} && $pdfopts->{printer_id}) {
$form->{printer_id} = $pdfopts->{printer_id};
7f7cbb08 Moritz Bunkus
$form->get_printer_code($myconfig);
$printer_command = $form->{printer_command};
}
if ($printer_command) {
$self->_print_content('printer_command' => $printer_command,
'content' => $content,
222bbfe9 Moritz Bunkus
'copies' => $pdfopts->{copies});
7f7cbb08 Moritz Bunkus
$form->{report_generator_printed} = 1;

} else {
078bf25d Jan Büren
# 3. default: redirect http with file attached
7f7cbb08 Moritz Bunkus
my $filename = $self->get_attachment_basename();

print qq|content-type: application/pdf\n|;
print qq|content-disposition: attachment; filename=${filename}.pdf\n\n|;
42b702a6 Moritz Bunkus
cc042e07 Sven Schöling
$::locale->with_raw_io(\*STDOUT, sub {
print $content;
});
7f7cbb08 Moritz Bunkus
}
42b702a6 Moritz Bunkus
}

a939b727 Moritz Bunkus
sub verify_paper_size {
my $self = shift;
my $requested_paper_size = lc shift;
my $default_paper_size = shift;

26a6e8b0 Moritz Bunkus
my %allowed_paper_sizes = map { $_ => 1 } qw(a3 a4 a5 letter legal);
a939b727 Moritz Bunkus
return $allowed_paper_sizes{$requested_paper_size} ? $requested_paper_size : $default_paper_size;
}

7f7cbb08 Moritz Bunkus
sub _print_content {
my $self = shift;
my %params = @_;

foreach my $i (1 .. max $params{copies}, 1) {
my $printer = IO::File->new("| $params{printer_command}");
$main::form->error($main::locale->text('Could not spawn the printer command.')) if (!$printer);
$printer->print($params{content});
$printer->close();
}
}

7a0da5ac Moritz Bunkus
sub _handle_quoting_and_encoding {
d9ab23fa Bernd Bleßmann
my ($self, $text, $do_unquote, $encoding) = @_;
0d3ea611 Moritz Bunkus
7a0da5ac Moritz Bunkus
$text = $main::locale->unquote_special_chars('HTML', $text) if $do_unquote;
d9ab23fa Bernd Bleßmann
$text = Encode::encode($encoding || 'UTF-8', $text);
0d3ea611 Moritz Bunkus
return $text;
}

a939b727 Moritz Bunkus
sub generate_csv_content {
7a0da5ac Moritz Bunkus
my $self = shift;
my $stdout = ($::dispatcher->get_standard_filehandles)[1];

# Text::CSV_XS seems to downgrade to bytes already (see
# SL/FCGIFixes.pm). Therefore don't let FCGI do that again.
$::locale->with_raw_io($stdout, sub { $self->_generate_csv_content($stdout) });
}

sub _generate_csv_content {
my ($self, $stdout) = @_;
a939b727 Moritz Bunkus
my %valid_sep_chars = (';' => ';', ',' => ',', ':' => ':', 'TAB' => "\t");
my %valid_escape_chars = ('"' => 1, "'" => 1);
my %valid_quote_chars = ('"' => 1, "'" => 1);

my $opts = $self->{options}->{csv_export};
my $eol = $opts->{eol_style} eq 'DOS' ? "\r\n" : "\n";
my $sep_char = $valid_sep_chars{$opts->{sep_char}} ? $valid_sep_chars{$opts->{sep_char}} : ';';
my $escape_char = $valid_escape_chars{$opts->{escape_char}} ? $opts->{escape_char} : '"';
my $quote_char = $valid_quote_chars{$opts->{quote_char}} ? $opts->{quote_char} : '"';

$escape_char = $quote_char if ($opts->{escape_char} eq 'QUOTE_CHAR');

my $csv = Text::CSV_XS->new({ 'binary' => 1,
'sep_char' => $sep_char,
'escape_char' => $escape_char,
'quote_char' => $quote_char,
'eol' => $eol, });

my @visible_columns = $self->get_visible_columns('CSV');

if ($opts->{headers}) {
84ba8214 Moritz Bunkus
if (!$self->{custom_headers}) {
d9ab23fa Bernd Bleßmann
$csv->print($stdout, [ map { $self->_handle_quoting_and_encoding($self->{columns}->{$_}->{text}, 1, $opts->{encoding}) } @visible_columns ]);
84ba8214 Moritz Bunkus
} else {
078fa02a Moritz Bunkus
foreach my $row (@{ $self->{custom_headers} }) {
62311126 Moritz Bunkus
my $fields = [ ];
078fa02a Moritz Bunkus
foreach my $col (@{ $row }) {
my $num_output = ($col->{colspan} && ($col->{colspan} > 1)) ? $col->{colspan} : 1;
d9ab23fa Bernd Bleßmann
push @{ $fields }, ($self->_handle_quoting_and_encoding($col->{text}, 1, $opts->{encoding})) x $num_output;
078fa02a Moritz Bunkus
}

$csv->print($stdout, $fields);
84ba8214 Moritz Bunkus
}
}
a939b727 Moritz Bunkus
}

foreach my $row_set (@{ $self->{data} }) {
24e8b084 Moritz Bunkus
next if ('ARRAY' ne ref $row_set);
a939b727 Moritz Bunkus
foreach my $row (@{ $row_set }) {
27bdd44b Moritz Bunkus
my @data;
078fa02a Moritz Bunkus
my $skip_next = 0;
27bdd44b Moritz Bunkus
foreach my $col (@visible_columns) {
078fa02a Moritz Bunkus
if ($skip_next) {
$skip_next--;
next;
}

1c2b6d08 Sven Schöling
my $num_output = ($row->{$col}{colspan} && ($row->{$col}->{colspan} > 1)) ? $row->{$col}->{colspan} : 1;
078fa02a Moritz Bunkus
$skip_next = $num_output - 1;

d9ab23fa Bernd Bleßmann
push @data, join($eol, map { s/\r?\n/$eol/g; $self->_handle_quoting_and_encoding($_, 0, $opts->{encoding}) } @{ $row->{$col}->{data} });
078fa02a Moritz Bunkus
push @data, ('') x $skip_next if ($skip_next);
27bdd44b Moritz Bunkus
}
078fa02a Moritz Bunkus
27bdd44b Moritz Bunkus
$csv->print($stdout, \@data);
a939b727 Moritz Bunkus
}
}
}

22ab10f7 Bernd Bleßmann
sub generate_chart_content {
my ($self, %params) = @_;

$params{action_bar} //= 1;

my $opts = $self->{options};

b77889e1 Bernd Bleßmann
my $assignment_x = $opts->{chart_export}->{assignment_x};
my $assignments_y = $opts->{chart_export}->{assignments_y};
22ab10f7 Bernd Bleßmann
b77889e1 Bernd Bleßmann
my @labels;
my @datasets;
22ab10f7 Bernd Bleßmann
foreach my $row_set (@{ $self->{data} }) {
next if ('ARRAY' ne ref $row_set);
foreach my $row (@{ $row_set }) {
b77889e1 Bernd Bleßmann
my $label = $row->{$assignment_x}->{data}->[0];
if ($label) {
push @labels, $label;

my @set;
foreach my $assignment_y (@$assignments_y) {
my $y = $row->{$assignment_y}->{data}->[0];
push @set, $y;
}
push @datasets, \@set;
22ab10f7 Bernd Bleßmann
}
}
}

my $variables = {
'TITLE' => $opts->{title},
'TOP_INFO_TEXT' => $self->html_format($opts->{top_info_text}),
'RAW_TOP_INFO_TEXT' => $opts->{raw_top_info_text},
'BOTTOM_INFO_TEXT' => $self->html_format($opts->{bottom_info_text}),
'RAW_BOTTOM_INFO_TEXT' => $opts->{raw_bottom_info_text},
'EXPORT_VARIABLE_LIST' => join(' ', @{ $self->{export}->{variable_list} }),
'EXPORT_NEXTSUB' => $self->{export}->{nextsub},
'DATA_PRESENT' => $self->{data_present},
'CONTROLLER_DISPATCH' => $opts->{controller_class},
'TABLE_CLASS' => $opts->{table_class},
'SKIP_BUTTONS' => !!$params{action_bar},
};

$::request->layout->add_javascripts('chart.js', 'kivi.ChartReport.js');

$::form->header;
print $::form->parse_html_template('report_generator/chart_report',
{
b77889e1 Bernd Bleßmann
labels => to_json(\@labels),
datasets => to_json(\@datasets),
data_labels => to_json($assignments_y),
22ab10f7 Bernd Bleßmann
%$variables,
}
);
}

1320854c Sven Schöling
sub check_for_pdf_api {
return eval { require PDF::API2; 1; } ? 1 : 0;
}

a939b727 Moritz Bunkus
1;
ee5d63a6 Sven Schöling
__END__

=head1 NAME

008c2e15 Moritz Bunkus
SL::ReportGenerator.pm: the kivitendo way of getting data in shape
ee5d63a6 Sven Schöling
=head1 SYNOPSIS

my $report = SL::ReportGenerator->new(\%myconfig, $form);
$report->set_options(%options); # optional
$report->set_columns(%column_defs);
$report->set_sort_indicator($column, $direction); # optional
$report->add_data($row1, $row2, @more_rows);
$report->generate_with_headers();

76c486e3 Sven Schöling
This creates a report object, sets a few columns, adds some data and generates a standard report.
ee5d63a6 Sven Schöling
Sorting of columns will be alphabetic, and options will be set to their defaults.
The report will be printed including table headers, html headers and http headers.

=head1 DESCRIPTION

Imagine the following scenario:
There's a simple form, which loads some data from the database, and needs to print it out. You write a template for it.
Then there may be more than one line. You add a loop in the template.
Then there are some options made by the user, such as hidden columns. You add more to the template.
Then it lacks usability. You want it to be able to sort the data. You add code for that.
Then there are too many results, you need pagination, you want to print or export that data..... and so on.

008c2e15 Moritz Bunkus
The ReportGenerator class was designed because this exact scenario happened about half a dozen times in kivitendo.
76c486e3 Sven Schöling
It's purpose is to manage all those formating, culling, sorting, and templating.
75f43bc1 Geoffrey Richardson
Which makes it almost as complicated to use as doing the work by yourself.
ee5d63a6 Sven Schöling
=head1 FUNCTIONS

=over 4

=item new \%myconfig,$form,%options

Creates a new ReportGenerator object, sets all given options, and returns it.

cfbcb233 Sven Schöling
=item set_columns %columns
ee5d63a6 Sven Schöling
Sets the columns available to this report.

=item set_column_order @columns

Sets the order of columns. Any columns not present here are appended in alphabetic order.

=item set_sort_indicator $column,$direction

75f43bc1 Geoffrey Richardson
Sets sorting of the table by specifying a column and a direction, where the direction will be evaluated to ascending if true.
Note that this is only for displaying. The data has to have already been sorted when it was added.
ee5d63a6 Sven Schöling
=item add_data \@data

=item add_data \%data

75f43bc1 Geoffrey Richardson
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. Every line will be expected to
be in a key => value format. Note that the rows have to already have been
sorted.
cc743b54 Geoffrey Richardson
The ReportGenerator is only able to display pre-sorted data and to indicate by
which column and in which direction the data has been sorted via visual clues
in the column headers. It also provides links to invert the sort direction.
ee5d63a6 Sven Schöling
=item add_separator

Adds a separator line to the report.

=item add_control \%data

Adds a control element to the data. Control elements are an experimental feature to add functionality to a report the regular data cannot.
75f43bc1 Geoffrey Richardson
Every control element needs to set IS_CONTROL_DATA, in order to be recognized by the template.
ee5d63a6 Sven Schöling
Currently the only control element is a colspan element, which can be used as a mini header further down the report.

=item clear_data

75f43bc1 Geoffrey Richardson
Deletes all data added to the report, but keeps options set.
ee5d63a6 Sven Schöling
=item set_options %options

Sets options. For an incomplete list of options, see section configuration.

=item set_options_from_form

Tries to import options from the $form object given at creation

=item set_export_options $next_sub,@variable_list

Sets next_sub and additional variables needed for export.

=item get_attachment_basename

Returns the set attachment_basename option, or 'report' if nothing was set. See configuration for the option.

=item generate_with_headers

76c486e3 Sven Schöling
Parses the report, adds headers and prints it out. Headers depend on the option 'output_format',
ee5d63a6 Sven Schöling
for example 'HTML' will add proper table headers, html headers and http headers. See configuration for this option.

=item get_visible_columns $format

Returns a list of columns that will be visible in the report after considering all options or match the given format.

=item html_format $value

Escapes HTML characters in $value and substitutes newlines with '<br>'. Returns the escaped $value.

=item prepare_html_content $column,$name,@column_headers

76c486e3 Sven Schöling
Parses the data, and sets internal data needed for certain output format. Must be called once before the template is invoked.
75f43bc1 Geoffrey Richardson
Should not be called externally, since all render and generate functions invoke it anyway.
76c486e3 Sven Schöling
ee5d63a6 Sven Schöling
=item generate_html_content

The html generation function. Is invoked by generate_with_headers.

=item generate_pdf_content

96627c43 Moritz Bunkus
The PDF generation function. It is invoked by generate_with_headers and renders the PDF with the PDF::API2 library.
ee5d63a6 Sven Schöling
078bf25d Jan Büren
If the param want_binary_pdf is set, the binary pdf stream will be returned.
If $pdfopts->{print} && $pdfopts->{printer_id} are set, the pdf will be printed (output is directed to print command).

Otherwise and the default a html form with a downloadable file is returned.

ee5d63a6 Sven Schöling
=item generate_csv_content

The CSV generation function. Uses XS_CSV to parse the information into csv.

=back

=head1 CONFIGURATION

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.

=head2 General Options

=over 4

=item std_column_visibility

Standard column visibility. Used if no visibility is set. Use this to save the trouble of enabling every column. Default is no.

=item output_format

Output format. Used by generate_with_headers to determine the format. Supported options are HTML, CSV, and PDF. Default is HTML.

=item allow_pdf_export

d43904e8 Moritz Bunkus
Used to determine if a button for PDF export should be displayed. Default is yes.
ee5d63a6 Sven Schöling
=item allow_csv_export

Used to determine if a button for CSV export should be displayed. Default is yes.

=item html_template

The template to be used for HTML reports. Default is 'report_generator/html_report'.

1320854c Sven Schöling
=item controller_class

If this is used from a C<SL::Controller::Base> based controller class, pass the
class name here and make sure C<SL::Controller::Helper::ReportGenerator> is
used in the controller. That way the exports stay functional.

ee5d63a6 Sven Schöling
=back

=head2 PDF Options

=over 4

=item paper_size

99a0ac76 Moritz Bunkus
Paper size. Default is a4. Supported paper sizes are a3, a4, a5, letter and legal.
ee5d63a6 Sven Schöling
=item orientation (landscape)

Landscape or portrait. Default is landscape.

76c486e3 Sven Schöling
=item font_name
ee5d63a6 Sven Schöling
99a0ac76 Moritz Bunkus
Default is Verdana. Supported font names are Courier, Georgia, Helvetica, Times and Verdana. This option only affects the rendering with PDF::API2.
ee5d63a6 Sven Schöling
=item font_size

99a0ac76 Moritz Bunkus
Default is 7. This option only affects the rendering with PDF::API2.
ee5d63a6 Sven Schöling
=item margin_top

=item margin_left

=item margin_bottom

=item margin_right

99a0ac76 Moritz Bunkus
The paper margins in cm. They all default to 1.5.
ee5d63a6 Sven Schöling
=item number

99a0ac76 Moritz Bunkus
Set to a true value if the pages should be numbered. Default is 1.
ee5d63a6 Sven Schöling
=item print

99a0ac76 Moritz Bunkus
If set then the resulting PDF will be output to a printer. If not it will be downloaded by the user. Default is no.
ee5d63a6 Sven Schöling
=item printer_id

Default 0.

=item copies

Default 1.

=back

=head2 CSV Options

=over 4

=item quote_char

Character to enclose entries. Default is double quote (").

=item sep_char

Character to separate entries. Default is semicolon (;).

=item escape_char

99a0ac76 Moritz Bunkus
Character to escape the quote_char. Default is double quote (").
ee5d63a6 Sven Schöling
=item eol_style

End of line style. Default is Unix.

=item headers

Include headers? Default is yes.

d9ab23fa Bernd Bleßmann
=item encoding

Character encoding. Default is UTF-8.

ee5d63a6 Sven Schöling
=back

=head1 SEE ALO

C<Template.pm>

=head1 MODULE AUTHORS

Moritz Bunkus E<lt>mbunkus@linet-services.deE<gt>

L<http://linet-services.de>