File Coverage

blib/lib/HTML/Strip/Whitespace.pm
Criterion Covered Total %
statement 89 98 90.8
branch 19 26 73.0
condition 9 10 90.0
subroutine 21 23 91.3
pod 1 1 100.0
total 139 158 87.9


line stmt bran cond sub pod time code
1             package HTML::Strip::Whitespace;
2             $HTML::Strip::Whitespace::VERSION = '0.2.2';
3 1     1   67212 use strict;
  1         11  
  1         28  
4 1     1   5 use warnings;
  1         2  
  1         23  
5              
6 1     1   17 use 5.016;
  1         3  
7              
8             package HTML::Strip::Whitespace::State;
9             $HTML::Strip::Whitespace::State::VERSION = '0.2.2';
10             sub new
11             {
12 8     8   16 my $class = shift;
13 8         14 my $self = {};
14 8         15 bless $self, $class;
15 8         23 $self->initialize(@_);
16 8         14 return $self;
17             }
18              
19             sub to_array
20             {
21 8     8   12 my $v = shift;
22 8 50       37 return ( ref($v) eq "ARRAY" ? (@$v) : $v );
23             }
24              
25             sub initialize
26             {
27 8     8   14 my $self = shift;
28 8         21 my %args = (@_);
29 8         18 $self->{'prev'} = undef;
30 8         16 $self->{'next'} = undef;
31 8         14 $self->{'this'} = undef;
32             $self->{'parser'} =
33 8         18 HTML::TokeParser::Simple->new( to_array( $args{'parser_args'} ) );
34              
35 8   100     1172 $self->{'strip_newlines'} = $args{'strip_newlines'} || 0;
36 8         14 $self->{'out_fh'} = $args{'out_fh'};
37              
38             # Get the first element to initialize the parser
39             # Otherwise the first call to next_state would return undef;
40 8         22 $self->next_state();
41              
42 8         17 return 0;
43             }
44              
45             sub next_state
46             {
47 118     118   293 my $self = shift;
48             ( $self->{'prev'}, $self->{'this'}, $self->{'next'} ) =
49 118         252 ( $self->{'this'}, $self->{'next'}, $self->{'parser'}->get_token() );
50 118 100       3483 if ( !defined( $self->{'this'} ) )
51             {
52 16         69 return undef;
53             }
54 102         406 return 1;
55             }
56              
57             sub prev
58             {
59 0     0   0 my $self = shift;
60 0         0 return $self->{'prev'};
61             }
62              
63             sub next
64             {
65 0     0   0 my $self = shift;
66 0         0 return $self->{'next'};
67             }
68              
69             sub this
70             {
71 256     256   331 my $self = shift;
72 256         509 return $self->{'this'};
73             }
74              
75             sub text_strip
76             {
77 40     40   54 my $self = shift;
78              
79             # my $p = $self->prev();
80             # my $n = $self->next();
81              
82 40         63 my $text = $self->this()->as_is();
83              
84 40 100       256 $text =~ s{([\s\n]+)}{($1 =~ /\n/) ? "\n" : " "}eg;
  48         199  
85              
86 40         143 return $text;
87             }
88              
89             my %preserving_start_tags = ( 'pre' => 1, );
90              
91             sub is_preserving_start_tag
92             {
93 50     50   68 my $self = shift;
94 50         87 my $t = $self->this();
95 50 100 100     107 if ( $t->is_start_tag()
96             && exists( $preserving_start_tags{ $t->get_tag() } ) )
97             {
98 2         29 return $t->get_tag();
99             }
100 48         430 return undef;
101             }
102              
103             sub handle_text
104             {
105 90     90   132 my $state = shift;
106              
107 90 100       138 if ( $state->this->is_text() )
108             {
109 40         144 $state->out( $state->text_strip() );
110 40         109 return 0;
111             }
112             else
113             {
114 50         208 return 1;
115             }
116             }
117              
118             sub out
119             {
120 102     102   383 my $self = shift;
121 102         166 my $what = shift;
122 102         173 my $out_fh = $self->{'out_fh'};
123              
124 102 50       226 if ( ref($out_fh) eq "CODE" )
    50          
    0          
125             {
126 0         0 &{$out_fh}($what);
  0         0  
127             }
128             elsif ( ref($out_fh) eq "SCALAR" )
129             {
130 102         178 $$out_fh .= $what;
131             }
132             elsif ( ref($out_fh) eq "GLOB" )
133             {
134 0         0 print { *{$out_fh} } $what;
  0         0  
  0         0  
135             }
136              
137 102         180 return 0;
138             }
139              
140             sub out_this
141             {
142 62     62   95 my $state = shift;
143 62         98 $state->out( $state->this()->as_is() );
144             }
145              
146             sub process
147             {
148 8     8   9 my $state = shift;
149              
150 8         14 my $tag_type;
151              
152 8         15 while ( $state->next_state() )
153             {
154 90 100       163 if ( !$state->handle_text() )
    100          
155             {
156             # Text was handled
157             }
158              
159             # If it's a preserving start tag, preserve all the text inside it.
160             # This is for example, a
 tag in which the spaces matter. 
161             elsif ( $tag_type = $state->is_preserving_start_tag() )
162             {
163 2         15 my $do_once = 1;
164 2   66     7 while ( $do_once || $state->next_state() )
165             {
166 14         21 $do_once = 0;
167 14         30 $state->out_this();
168 14 100       27 last if ( $state->this()->is_end_tag($tag_type) );
169             }
170             }
171             else
172             {
173 48         83 $state->out_this();
174             }
175             }
176              
177             # Return 0 on success.
178 8         56 return 0;
179             }
180              
181             package HTML::Strip::Whitespace;
182              
183 1     1   17 use 5.008;
  1         3  
184 1     1   6 use strict;
  1         2  
  1         18  
185 1     1   5 use warnings;
  1         1  
  1         44  
186              
187 1     1   518 use HTML::TokeParser::Simple;
  1         18761  
  1         39  
188              
189 1     1   459 use parent 'Exporter';
  1         297  
  1         7  
190 1     1   60 use vars qw(@EXPORT @EXPORT_OK %EXPORT_TAGS);
  1         2  
  1         197  
191              
192             %EXPORT_TAGS = (
193             'all' => [
194             qw(
195             html_strip_whitespace
196             )
197             ]
198             );
199              
200             @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
201              
202             @EXPORT = qw(
203              
204             );
205              
206             # Preloaded methods go here.
207              
208             sub html_strip_whitespace
209             {
210 8     8 1 2069 my %args = (@_);
211 8 50       26 my $source = $args{'source'}
212             or die "source argument not specified.";
213 8   100     38 my $strip_newlines = $args{'strip_newlines'} || 0;
214 8 50       21 my $out_fh = $args{'out'}
215             or die "out argument not specified.";
216 8         26 my $state = HTML::Strip::Whitespace::State->new(
217             'parser_args' => $source,
218             'strip_newlines' => $strip_newlines,
219             'out_fh' => $out_fh,
220             );
221              
222 8         20 return $state->process();
223             }
224              
225             # Autoload methods go after =cut, and are processed by the autosplit program.
226              
227             1;
228              
229             __END__