File Coverage

blib/lib/HTML/Strip/Whitespace.pm
Criterion Covered Total %
statement 87 96 90.6
branch 17 24 70.8
condition 9 10 90.0
subroutine 21 23 91.3
pod 1 1 100.0
total 135 154 87.6


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