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