File Coverage

blib/lib/PPI/HTML/Fragment.pm
Criterion Covered Total %
statement 40 40 100.0
branch 10 18 55.5
condition n/a
subroutine 12 12 100.0
pod 0 7 0.0
total 62 77 80.5


line stmt bran cond sub pod time code
1             package PPI::HTML::Fragment;
2              
3             # A HTML fragment object is a small object that contains a string due to
4             # become HTML content, and a simple rule for it's display, such as a class
5             # name.
6              
7 2     2   11 use strict;
  2         6  
  2         74  
8              
9 2     2   11 use vars qw{$VERSION};
  2         3  
  2         88  
10             BEGIN {
11 2     2   1058 $VERSION = '1.08';
12             }
13              
14              
15              
16              
17              
18             #####################################################################
19             # Constructor and Accessors
20              
21             sub new {
22 40 50   40 0 75 my $class = ref $_[0] ? ref shift : shift;
23 40 50       79 my $string = defined $_[0] ? shift : return undef;
24 40 50       74 my $css = shift or return undef;
25              
26             # Create the basic object
27 40         163 my $self = bless {
28             string => $string,
29             css    => $css,
30             }, $class;
31              
32 40         154 $self;
33             }
34              
35 78     78 0 243 sub string { $_[0]->{string} }
36 247     247 0 970 sub css { $_[0]->{css} }
37              
38              
39              
40              
41              
42             #####################################################################
43             # Main Methods
44              
45             # Does the segment end with a newline?
46 38     38 0 62 sub ends_line { $_[0]->string =~ /\n$/ }
47              
48             # Render to HTML
49             sub html {
50 36     36 0 44 my $self = shift;
51 36         57 my $html = $self->_escape( $self->string );
52 36 100       72 return $html unless $self->css;
53 20         37 $self->_tagpair( 'span', { class => $self->css }, $html );
54             }
55              
56             sub concat {
57 4     4 0 4 my $self = shift;
58 4 50       8 my $string = defined $_[0] ? shift : return undef;
59 4         7 $self->{string} .= $string;
60 4         9 1;
61             }
62              
63             sub clear {
64 16     16 0 19 my $self = shift;
65 16         26 delete $self->{css};
66 16         36 1;
67             }
68              
69              
70              
71              
72              
73             #####################################################################
74             # Support Methods
75              
76             # Embedding some HTML stuff until I find a suitably lightweight dependency
77             sub _escape {
78 36 50   36   73 my $html = defined $_[1] ? "$_[1]" : return '';
79 36         46 $html =~ s/&/&/g;
80 36         44 $html =~ s/</&lt;/g;
81 36         40 $html =~ s/>/&gt;/g;
82 36         44 $html =~ s/\"/&quot;/g;
83 36         96 $html =~ s/(\015{1,2}\012|\015|\012)/<br>\n/g;
84 36         68 $html;
85             }
86              
87             sub _tagpair {
88 20     20   27 my $class = shift;
89 20 50       37 my $tag = shift or return undef;
90 20 50       43 my %attr = ref $_[0] eq 'HASH' ? %{shift()} : ();
  20         70  
91 20 50       92 my $start = join( ' ', $tag,
92 20         55 map { defined $attr{$_} ? qq($_="$attr{$_}") : "$_" }
93             sort keys %attr );
94 20         133 "<$start>" . join('', @_) . "</$tag>";
95             }
96              
97             1;
98