File Coverage

blib/lib/Data/Report/Plugin/Html.pm
Criterion Covered Total %
statement 56 64 87.5
branch 22 28 78.5
condition 7 9 77.7
subroutine 9 9 100.0
pod 0 3 0.0
total 94 113 83.1


line stmt bran cond sub pod time code
1             # Data::Report::Plugin::Html.pm -- HTML plugin for Data::Report
2             # Author : Johan Vromans
3             # Created On : Thu Dec 29 15:46:47 2005
4             # Last Modified By: Johan Vromans
5             # Last Modified On: Sun Feb 9 19:52:28 2020
6             # Update Count : 84
7             # Status : Unknown, Use with caution!
8              
9             package Data::Report::Plugin::Html;
10              
11 8     8   2631 use strict;
  8         19  
  8         263  
12 8     8   42 use warnings;
  8         15  
  8         231  
13 8     8   40 use base qw(Data::Report::Base);
  8         14  
  8         4122  
14              
15             ################ API ################
16              
17             my $html_use_entities = 0;
18              
19             sub start {
20 7     7 0 68 my ($self) = @_;
21 7         28 $self->_argcheck(0);
22 7         15 eval {
23 7         3560 require HTML::Entities;
24 7         40279 $html_use_entities = 1;
25             };
26 7         78 $self->SUPER::start();
27 7         20 $self->{used} = 0;
28             }
29              
30             sub finish {
31 7     7 0 34 my ($self) = @_;
32 7         23 $self->_argcheck(0);
33 7 100       33 if ( $self->{used} ) {
34 6         22 $self->_print("
\n"); 35             } 36 7         50 $self->SUPER::finish(); 37             } 38               39             sub add { 40 18     18 0 99 my ($self, $data) = @_; 41               42 18         38 my $style = delete($data->{_style}); 43               44 18         72 $self->SUPER::add($data); 45               46 18 50       59 return unless %$data; 47               48 18 100 100     76 if ( $style and my $t = $self->_getstyle($style) ) { 49 2 50       21 return if $t->{ignore}; 50             } 51               52 18         112 $self->{used}++; 53               54 18         75 $self->_checkhdr; 55               56 18 100       92 $self->_print("\n"); 57               58 18         31 foreach my $col ( @{$self->_get_fields} ) {   18         49   59 78         132 my $fname = $col->{name}; 60 78 50       176 my $value = defined($data->{$fname}) ? $data->{$fname} : ""; 61               62             # Examine style mods. 63 78         185 my $t = $self->_getstyle($style, $fname); 64 78 100       192 next if $t->{ignore}; 65               66 74   66     237 my $class = $t->{class} || "c_$fname"; 67               68             $self->_print("{align}), 69             "class=\"$class\">", 70             $value eq "" 71             ? " " 72             : $t->{raw_html} 73 74 100       148 ? $value     50           74             : $self->_html($value), 75             "\n"); 76             } 77               78 18         48 $self->_print("\n"); 79             } 80               81             ################ Pseudo-Internal (used by Base class) ################ 82               83             sub _std_heading { 84 6     6   22 my ($self) = @_; 85 6         21 $self->_argcheck(0); 86               87 6         27 $self->_print("\n"); \n"); \n");
88              
89 6         61 $self->_print("
90 6         11 foreach ( @{$self->_get_fields} ) {
  6         35  
91              
92             # Examine style mods.
93 26         75 my $t = $self->_getstyle("_head", $_->{name});
94 26 100       80 next if $t->{ignore};
95              
96 24   66     94 my $class = $t->{class} || "h_" . $_->{name};
97              
98             $self->_print("{align}),
99             "class=\"$class\">",
100 24         56 $self->_html($_->{title}), "\n");
101             }
102 6         32 $self->_print("
103              
104             }
105              
106             ################ Internal methods ################
107              
108             sub _align {
109 98 100   98   289 return 'align="right" ' if $_[0] eq '>';
110 77 100       251 return 'align="left" ' if $_[0] eq '<';
111 26 50       117 return 'align="center" ' if $_[0] eq '|';
112 0         0 ""
113             }
114              
115             sub _html {
116 110     110   351 shift;
117 110 50       198 if ( $html_use_entities ) {
118 110         229 return HTML::Entities::encode(shift);
119             }
120              
121 0           my ($t) = @_;
122 0           $t =~ s/&/&/g;
123 0           $t =~ s/
124 0           $t =~ s/>/>/g;
125 0           $t =~ s/\240/ /g;
126 0           $t =~ s/\x{eb}/ë/g; # for IVP.
127 0           $t;
128             }
129              
130             1;