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