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