File Coverage

blib/lib/Report/Porf/Table/Simple/HtmlReportConfigurator.pm
Criterion Covered Total %
statement 184 210 87.6
branch 38 74 51.3
condition 2 9 22.2
subroutine 24 28 85.7
pod 0 13 0.0
total 248 334 74.2


line stmt bran cond sub pod time code
1             # perl
2             #
3             # Class Report::Porf::HtmlReportConfigurator
4             #
5             # Perl Open Report Framework (Porf)
6             #
7             # Configures a Report::Porf::Table::Simple to write out HTML tables
8             #
9             # Ralf Peine, Tue May 27 11:29:32 2014
10             #
11             # More documentation at the end of file
12             #------------------------------------------------------------------------------
13              
14             $VERSION = "2.001";
15              
16             #------------------------------------------------------------------------------
17             #
18             # Example list with 10 lines (html)
19             #
20             #
21             #
22             #
23             #
24             #
CounTimeStamp Age Prename Surname
25             #
26             #
27             #
1 0.000433 10 Vorname 1 Name 1
28             #
2 0.000638 20 Vorname 2 Name 2
29             #
3 0.000781 30 Vorname 3 Name 3
30             #
4 0.000922 40 Vorname 4 Name 4
31             #
5 0.001062 50 Vorname 5 Name 5
32             #
6 0.001203 60 Vorname 6 Name 6
33             #
7 0.001346 70 Vorname 7 Name 7
34             #
8 0.001486 80 Vorname 8 Name 8
35             #
9 0.001631 90 Vorname 9 Name 9
36             #
10 0.001773 100 Vorname 10 Name 10
37             #
38             #

39             # # Time needed for export of 10 data lines: 0.002013
40             #
41             #
42             #
43              
44 1     1   6 use strict;
  1         2  
  1         41  
45 1     1   5 use warnings;
  1         1  
  1         35  
46              
47             #--------------------------------------------------------------------------------
48             #
49             # Report::Porf::Table::Simple::HtmlReportConfigurator;
50             #
51             #--------------------------------------------------------------------------------
52              
53             package Report::Porf::Table::Simple::HtmlReportConfigurator;
54              
55 1     1   5 use Carp;
  1         2  
  1         89  
56              
57 1     1   6 use Report::Porf::Util;
  1         2  
  1         135  
58 1     1   7 use Report::Porf::Table::Simple;
  1         1  
  1         754  
59              
60             #--------------------------------------------------------------------------------
61             #
62             # Creation / Filling Of Instances
63             #
64             #--------------------------------------------------------------------------------
65              
66             # --- create Instance -----------------
67             sub new
68             {
69 4     4 0 869 my $caller = $_[0];
70 4   33     22 my $class = ref($caller) || $caller;
71            
72             # let the class go
73 4         7 my $self = {};
74 4         15 bless $self, $class;
75              
76 4         12 $self->_init();
77            
78 4         10 return $self;
79             }
80              
81             # --- Init ------------------------------------------------------------------
82              
83             sub _init {
84 4     4   7 my ($self # instance_ref
85             ) = @_;
86 4         21 $self->{AlternateRowColors} = [];
87 4         19 $self->set_escape_special_chars_action(\&Report::Porf::Util::escape_html_special_chars);
88             }
89              
90             # --- verbose ---------------------------------------------------------------
91              
92             sub set_verbose {
93 1     1 0 5 my ($self, # instance_ref
94             $value # value to set
95             ) = @_;
96            
97 1         3 $self->{verbose} = $value;
98             }
99              
100             sub get_verbose {
101 0     0 0 0 my ($self, # instance_ref
102             ) = @_;
103            
104 0         0 return $self->{verbose};
105             }
106              
107             # --- Text in op of table ------------------------------------------------------
108              
109             sub set_table_top_text {
110 0     0 0 0 my $self = shift; # instance_ref
111              
112 0         0 $self->{TableTopText} = shift;
113             }
114              
115             sub get_table_top_text {
116 4     4 0 5 my $self = shift; # instance_ref
117              
118 4         9 return $self->{TableTopText};
119             }
120             # --- Alternate Row Colors ------------------------------------------------------
121              
122             sub set_alternate_row_colors {
123 3     3 0 7 my $self = shift; # instance_ref
124              
125 3         7 $self->{AlternateRowColors} = [];
126 3         4 push (@{$self->{AlternateRowColors}}, @_);
  3         13  
127             }
128              
129             sub get_alternate_row_colors {
130 4     4 0 7 my ($self, # instance_ref
131             ) = @_;
132            
133 4         7 return @{$self->{AlternateRowColors}};
  4         15  
134             }
135              
136             # --- escape special chars ---------------------------------------------------------------
137              
138             sub set_escape_special_chars_action {
139 4     4 0 8 my ($self, # instance_ref
140             $value # value to set
141             ) = @_;
142              
143 4         14 $self->{escape_special_chars_action} = $value;
144             }
145              
146             sub get_escape_special_chars_action {
147 17     17 0 22 my ($self, # instance_ref
148             ) = @_;
149            
150 17         31 return $self->{escape_special_chars_action};
151             }
152              
153             # --- Add Attribute bgColor ------------------------------------------------------
154             sub add_background_color_attribute {
155 0     0 0 0 return add_optional_attribute('bgcolor', @_);
156             }
157              
158             # --- Add Attribute ------------------------------------------------------
159             sub add_optional_attribute {
160 0     0 0 0 my $name = shift;
161 0         0 my $value_str = shift;
162              
163 0 0 0     0 return " $name=\"$value_str\"" if (defined $value_str && $value_str ne '');
164              
165 0         0 return '';
166             }
167             #--------------------------------------------------------------------------------
168             #
169             # Configure formats
170             #
171             #--------------------------------------------------------------------------------
172              
173             # --- create new report and configure -------------------------------------------
174             sub create_and_configure_report {
175 3     3 0 4 my ($self # instance_ref
176             ) = @_;
177              
178 3         19 return $self->configure_report(Report::Porf::Table::Simple->new());
179             }
180              
181             # --- Configure Export For Html ------------------------------------------------
182             sub configure_report {
183 4     4 0 10 my ($self, # instance_ref
184             $report2configure, # report to be configured
185             ) = @_;
186              
187 4         94 $report2configure->set_format('HTML');
188              
189             # $self->set_default_column_width (10);
190 4         14 $report2configure->set_default_align ('Left');
191              
192 4         13 $report2configure->set_file_start("\n");
193 4         13 $report2configure->set_file_end ("\n");
194              
195 4         13 my $tableTopText = $self->get_table_top_text();
196 4 50       89 $tableTopText = '' unless $tableTopText;
197 4 50       12 $tableTopText = "

$tableTopText

\n" if $tableTopText;
198              
199 4         18 $report2configure->set_table_start("$tableTopText\n");
200 4         10 $report2configure->set_table_end ("

\n");

201              
202 4         12 my @row_colors = $self->get_alternate_row_colors();
203 4         8 my $switch = -1;
204              
205 4 100       11 if ( scalar @row_colors) {
206 3         11 $report2configure->set_table_start("$tableTopText\n"); '; '); \n"); \n"); \n\n"); ');
207             $report2configure->set_row_start(
208             sub
209             {
210 7     7   10 $switch++;
211 1 100   1   1181 $switch = $[ if $switch >= scalar @row_colors;
  1         541  
  1         2242  
  7         94  
212 7         27 return '
213 3         47 });
214             }
215             else {
216 1         4 $report2configure->set_row_start('
217             }
218            
219 4         13 $report2configure->set_row_end ("
220            
221 4         14 $report2configure->set_header_row_start("
222 4         13 $report2configure->set_header_row_end ("
223 4         12 $report2configure->set_header_start("");
224 4         13 $report2configure->set_header_end ("");
225            
226 4     21   21 $report2configure->set_cell_start( sub { return "''"; });
  21         272  
227 4         13 $report2configure->set_cell_end ('
228              
229 4         12 $report2configure->set_horizontal_separation_start ("
");
230 4         11 $report2configure->set_horizontal_separation_end ("\n");
231              
232 4         24 my %AlignmentToHtml = (
233             Left => 'left',
234             Center => 'center',
235             Right => 'right'
236             );
237            
238             #===================================================================================
239             #
240             # Configure Actions, no need to speed up
241             #
242             #===================================================================================
243              
244             # === Column store Action ============================================================
245             $report2configure->set_configure_column_action(
246             sub {
247 17     17   20 my $report = shift; # instance_ref
248 17         62 my %options = @_; # options
249            
250 17 50       45 print_hash_ref(\%options) if verbose($report, 2);
251            
252 17         23 my $left = ""; # left from value
253 17         20 my $right = ""; # right from value
254              
255 17         21 my $column_attributes = ""; # Attributes in td-Element
256              
257             # --- default value ---------------------------------------
258 17         41 my $default_value = get_option_value(\%options, qw (-default_value -def_val -dv));
259 17 50       60 $default_value = $report->get_default_cell_value() unless defined $default_value;
260              
261             # --- value ---------------------------------------
262 17         42 my $value = interprete_value_options(\%options);
263 17         32 my $value_ref = ref($value);
264 17         21 my $value_action;
265              
266 17 50       30 die "value action not defined" unless defined $value;
267            
268 17 100       39 if ( $value_ref) {
269 2 50       10 if ($value_ref =~ /^CODE/) {
270 2         5 $value_action = $value;
271             }
272             else {
273             # or what ??
274 0         0 die "# ref(value_ref) = $value_ref unknown";
275             # $value_action = eval ("sub { return $$value; };");
276             }
277             }
278             else {
279 15         33 $value = complete_value_code($value, $default_value);
280 15         49 $value_action = $report->create_action("$value;");
281             }
282              
283             # --- format value ----------------------------------------
284 17         52 my $format = get_option_value(\%options, qw (-format -f));
285              
286 17 50       39 if ($format) {
287 0         0 my $format_ref = ref($format);
288              
289 0 0       0 die "You used a '$format_ref' type to set the 'Format', "
290             ."but currently only strings are supported!"
291             if $format_ref;
292            
293 0 0       0 print "format $format\n" if verbose($report, 3);
294              
295 0         0 $left = "sprintf(\"$format\", ".$left;
296 0         0 $right .= ")";
297             }
298              
299             # --- escape special chars ----------------------------------------
300 17         41 my $escape_special_chars = get_option_value(\%options, qw (-escape_special_chars -esc_spec_chr -esc));
301              
302 17         25 my $do_escape_special_chars = 1;
303 17 50       30 if (defined $escape_special_chars) {
304 0         0 $do_escape_special_chars = $escape_special_chars;
305             }
306              
307 17         37 my $esc_action = $self->get_escape_special_chars_action();
308 17 50       43 $do_escape_special_chars = 0 unless $esc_action;
309              
310 17 50       150 if ($do_escape_special_chars) {
311 17         33 $left = '$esc_action->('.$left;
312 17         24 $right .= ')';
313             }
314            
315             # --- coloring --------------------------------------------
316 17         47 my $color = get_option_value(\%options, qw (-color -c));
317 17         24 my $color_action = undef;
318              
319 17 50       35 if ($color) {
320 0         0 my $color_ref = ref($color);
321            
322 0 0       0 if ( $color_ref) {
323 0 0       0 if ($color_ref =~ /^CODE/) {
324 0         0 $color_action = $color;
325 0         0 $column_attributes .= '. add_background_color_attribute($color_action->($_[0]))';
326             }
327             else {
328             # or what ??
329 0         0 die "# ref(color_ref) = $color_ref unknown";
330             }
331             }
332             else {
333 0         0 $column_attributes .= ".'" . add_background_color_attribute($color) ."'";
334             }
335             }
336              
337             # --- width is currently not supported ---------------------
338 17         39 my $width = get_option_value(\%options, qw (-width -w));
339              
340 17 50 33     37 print "width is currently not supported for html (width = $width)\n" if verbose($report, 3) && $width;
341            
342             # --- align -----------------------------------------------
343 17         42 my $align = get_option_value(\%options, qw (-align -a));
344              
345 17 100       36 if ($align) {
346 14         22 my $align_ref = ref($align);
347              
348 14 50       23 die "You used a '$align_ref' type to set the 'Align', "
349             ."but currently only strings are supported!"
350             if $align_ref;
351              
352 14         36 $align = interprete_alignment($align);
353             }
354             else {
355 3         14 $align = $report->get_default_align();
356             }
357              
358 17 50       1106 print "align $align\n" if verbose($report, 3);
359 17         40 my $column_align = $AlignmentToHtml{$align};
360              
361 17         34 $column_attributes .= '.\' align="'.$column_align.'"\'';
362            
363             # --- configure header ----------------------------
364              
365 17         39 my $header_text = get_option_value(\%options, qw (-header -h));
366 17 50       36 $header_text = '' unless defined $header_text;
367 17         16 push (@{$report->get_header_texts_ref()}, $header_text);
  17         47  
368            
369             # --- ---------------------------------------------
370             # --- ---------------------------------------------
371             # --- ---------------------------------------------
372              
373             # --- build cell content action ---------------------------------------------
374 17         506 my $cell_action_str = $left.'$value_action->($_[0])'.$right;
375              
376 17         41 my $cell_start = $report->get_cell_start()->($column_attributes);
377 17         48 my $cell_end = $report->get_cell_end();
378              
379 17         40 my $eval_str = 'sub { return '.$cell_start.".".$cell_action_str.'.$cell_end; }';
380              
381 17 50       42 print "### eval_str = $eval_str\n"
382             if verbose($report, 3);
383            
384 17         2453 my $cell_action = eval ($eval_str);
385              
386 17 50       44 die $@ if $@;
387            
388 17 50       54 print "### ref(cell_action) ".ref($cell_action) ."\n" if verbose($report, 3);
389            
390 17         48 $report->add_cell_output_action($cell_action);
391 4         74 });
392              
393             # === Configure Complete Action ====================================================
394             $report2configure->set_configure_complete_action(
395             sub {
396 4     4   6 my ($report, # instance_ref
397             ) = @_;
398              
399 4         16 my $row_start = $report->get_row_start();
400 4         11 my $row_start_ref = ref($row_start);
401              
402 4 100       10 if ( $row_start_ref) {
403 3 50       18 if ($row_start_ref =~ /^CODE/) {
404 3         8 $row_start = $row_start->(); # replace sub by content of call
405             }
406             else {
407             # or what ??
408 0         0 die "# ref(row_start_ref) = $row_start_ref unknown";
409             # $value_action = eval ("sub { return $$value; };");
410             }
411             }
412              
413 4         77 my $cell_start = $report->get_cell_start();
414 4         11 my $cell_start_ref = ref($cell_start);
415              
416 4 50       12 if ( $cell_start_ref) {
417 4 50       116 if ($cell_start_ref =~ /^CODE/) {
418 4         11 $cell_start = eval ($cell_start->('')); # replace sub by content of call
419             }
420             else {
421             # or what ??
422 0         0 die "# ref(cell_start_ref) = $cell_start_ref unknown";
423             # $value_action = eval ("sub { return $$value; };");
424             }
425             }
426              
427 4         13 my $sep = $row_start;
428            
429 4         8 foreach my $idx (1..scalar(@{$report->get_cell_output_actions()})) {
  4         14  
430 17         47 $sep .= $cell_start."
".$report->get_cell_end();
431             }
432              
433 4         17 $sep .= $report->get_row_end();
434            
435 4         15 $report->set_header_line ($sep);
436 4         14 $report->set_separator_line ($sep);
437 4         31 });
438            
439             #===================================================================================
440             #
441             # Runtime Actions, no need to speed up
442             #
443             #===================================================================================
444              
445             # === Header Output Action ============================================================
446             $report2configure->set_header_output_action(
447             sub {
448 1     1   2 my ($report, # instance_ref
449             $data_ref # data to output
450             ) = @_;
451              
452 1         5 my $header_string = $report->get_header_row_start();
453 1         3 foreach my $header_text (@{$data_ref}) {
  1         3  
454 4         13 $header_string .= $report->get_header_start()
455             .$header_text
456             .$report->get_header_end();
457             }
458              
459 1         4 $header_string .= $report->get_header_row_end();
460              
461 1 50       5 print "### Header String:$header_string" if verbose($report, 2);
462            
463 1         7 return $header_string;
464 4         25 });
465              
466             # === Start Table Output Action ============================================================
467             $report2configure->set_start_table_output_action(
468             sub {
469 1     1   3 my ($report, # instance_ref
470             $data_ref # data to output
471             ) = @_;
472              
473 1         6 return $report->get_file_start()
474             .$report->get_table_start()
475             .$report->get_header_output();
476            
477 4         32 });
478              
479             # === End Table Output Action ============================================================
480             $report2configure->set_end_table_output_action(
481             sub {
482 1     1   2 my ($report, # instance_ref
483             $data_ref # data to output
484             ) = @_;
485              
486 1         6 return $report->get_table_end()
487             .$report->get_file_end();
488 4         25 });
489              
490             #===================================================================================
491             #
492             # Runtime Mass Data Actions, be careful, don't slow it down !!
493             #
494             #===================================================================================
495              
496 4         6 my $previous_data_ref = '';
497              
498             # === Row Output Action ============================================================
499             $report2configure->set_row_output_action(
500             sub {
501 5     5   12 my ($report, # instance_ref
502             $data_ref # data to output
503             ) = @_;
504              
505 5         16 my $row_start = $report->get_row_start();
506 5         11 my $row_start_ref = ref($row_start);
507              
508 5 100       13 if ( $row_start_ref) {
509 4 50       17 if ($row_start_ref =~ /^CODE/) {
510 4         8 $row_start = $row_start->(); # replace sub by content of call
511             }
512             else {
513             # or what ??
514 0         0 die "# ref(row_start_ref) = $row_start_ref unknown";
515             # $value_action = eval ("sub { return $$value; };");
516             }
517             }
518              
519 5         8 my $row_string = '';
520              
521             # --- Add something when group changes ----
522 5         16 my $row_group_changes_action = $report->get_row_group_changes_action();
523              
524 5 50       17 $row_string .= $row_group_changes_action->($previous_data_ref, $data_ref)
525             if $row_group_changes_action;
526              
527 5         7 $previous_data_ref = $data_ref;
528              
529             # --- start new row -----------------------
530 5         11 $row_string .= $row_start;
531              
532 5         17 my $cell_output_actions_ref = $report->get_cell_output_actions();
533              
534 5         13 foreach my $action (@$cell_output_actions_ref) {
535 21 50       49 print "### action $action\n" if verbose($report, 4);
536 21         714 $row_string .= $action->($data_ref);
537             }
538              
539 5         19 $row_string .= $report->get_row_end();
540              
541 5 50       15 print "### Row String:$row_string" if verbose($report, 2);
542            
543 5         34 return $row_string;
544 4         53 });
545              
546 4         18 return $report2configure;
547             }
548              
549             1;
550              
551             =head1 NAME
552              
553             C
554              
555             Configures a Report::Porf::Table::Simple to write out HTML tables.
556              
557             Part of Perl Open Report Framework (Porf).
558              
559             =head1 Documentation
560              
561             See Report::Porf::Framework.pm for documentation of features and usage.
562              
563             =head1 LICENSE AND COPYRIGHT
564              
565             Copyright (c) 2013 by Ralf Peine, Germany. All rights reserved.
566              
567             This library is free software; you can redistribute it and/or modify
568             it under the same terms as Perl itself, either Perl version 5.6.0 or,
569             at your option, any later version of Perl 5 you may have available.
570              
571             =head1 DISCLAIMER OF WARRANTY
572              
573             This library is distributed in the hope that it will be useful,
574             but without any warranty; without even the implied warranty of
575             merchantability or fitness for a particular purpose.
576              
577             =cut