File Coverage

blib/lib/HTML/TableContentParser.pm
Criterion Covered Total %
statement 97 101 96.0
branch 42 48 87.5
condition 6 7 85.7
subroutine 9 10 90.0
pod 6 6 100.0
total 160 172 93.0


line stmt bran cond sub pod time code
1             package HTML::TableContentParser;
2              
3 2     2   1168 use strict;
  2         9  
  2         61  
4 2     2   10 use warnings;
  2         3  
  2         57  
5              
6 2     2   998 use parent qw{ HTML::Parser };
  2         696  
  2         11  
7              
8             our $VERSION = '0.304';
9              
10             our $CLASSIC = 0;
11             our $DEBUG = 0;
12              
13             my @stacked = qw{ current_table current_row current_element };
14              
15             sub new
16             {
17 3     3 1 8424 my ( $class, %arg ) = @_;
18 3         7 my $classic = delete $arg{classic};
19 3         23 my $self = $class->SUPER::new( %arg );
20 3 50       192 $self->{ATTR}{classic} = defined $classic ? $classic : $CLASSIC;
21 3         11 return $self;
22             }
23              
24             sub classic
25             {
26 1     1 1 15 my ( $self ) = @_;
27 1         8 return $self->{ATTR}{classic};
28             }
29              
30             sub start
31             {
32             # my ($self, $tag, $attr, $attrseq, $origtext) = @_;
33 85     85 1 189 my ($self, $tag, $attr, undef, $origtext) = @_;
34              
35 85         181 $tag = lc($tag);
36              
37             # Store the incoming details in the current 'object'.
38 85 100       226 if ($tag eq 'table') {
    100          
    100          
    100          
    100          
39 6         7 my $table = $attr;
40 6         15 push @{ $self->{STORE}{stack} }, {
41 6         11 map { $_ => $self->{STORE}{$_} } @stacked };
  18         57  
42 6         14 push @{$self->{STORE}->{tables}}, $table;
  6         15  
43 6         10 $self->{STORE}->{current_table} = $table;
44 6         12 $self->{STORE}->{current_row} = undef;
45 6         9 $self->{STORE}->{current_element} = undef;
46              
47             } elsif ($tag eq 'th') {
48 8         12 my $th = $attr;
49 8         10 push @{$self->{STORE}->{current_table}->{headers}}, $th;
  8         19  
50 8 100       19 unless ( $self->{ATTR}{classic} ) {
51 7         10 push @{$self->{STORE}->{current_row}->{cells}}, undef;
  7         25  
52 7         11 push @{$self->{STORE}->{current_row}->{headers}}, $th;
  7         14  
53             }
54 8         16 $self->{STORE}->{current_element} = $th;
55              
56             } elsif ($tag eq 'tr') {
57 20         29 my $tr = $attr;
58 20         27 push @{$self->{STORE}->{current_table}->{rows}}, $tr;
  20         42  
59 20         37 $self->{STORE}->{current_row} = $tr;
60 20         30 $self->{STORE}->{current_element} = $tr;
61              
62             } elsif ($tag eq 'td') {
63 29         42 my $td = $attr;
64 29         35 push @{$self->{STORE}->{current_row}->{cells}}, $td;
  29         77  
65 29 100       64 unless ( $self->{ATTR}{classic} ) {
66 25         32 push @{$self->{STORE}->{current_row}->{headers}}, undef;
  25         47  
67             }
68 29         45 $self->{STORE}->{current_element} = $td;
69              
70             } elsif ($tag eq 'caption') {
71 2         3 my $cap = $attr;
72 2         5 $self->{STORE}->{current_table}->{caption} = $cap;
73 2         5 $self->{STORE}->{current_element} = $cap;
74              
75             } else {
76             ## Found a non-table related tag. Push it into the currently-defined td
77             ## or th (if one exists).
78 20         34 my $elem = $self->{STORE}->{current_element};
79 20 100       40 if ($elem) {
80 4 50       9 $self->_debug('TEXT(tag) = ', $origtext) if $DEBUG;
81 4         9 $elem->{data} .= $origtext;
82             }
83              
84             }
85              
86 85 50       157 $self->_debug($origtext) if $DEBUG;
87              
88 85         336 return;
89             }
90              
91              
92              
93             sub text
94             {
95 113     113 1 258 my ($self, $text) = @_;
96 113         199 my $elem = $self->{STORE}->{current_element};
97 113 100       207 if (!$elem) {
98 69         288 return;
99             }
100              
101 44 50       76 $self->_debug('TEXT = ', $text) if $DEBUG;
102 44         93 $elem->{data} .= $text;
103              
104 44         159 return;
105             }
106              
107              
108              
109             sub end
110             {
111 85     85 1 171 my ($self, $tag, $origtext) = @_;
112 85         162 $tag = lc($tag);
113              
114             # Turn off the current object
115 85 100       235 if ($tag eq 'table') {
    100          
    100          
    100          
    100          
116 6   50     10 my $prev = pop @{ $self->{STORE}{stack} } || [];
117 6         32 $self->{STORE}{$_} = $prev->{$_} for @stacked;
118              
119             } elsif ($tag eq 'th') {
120 8         13 $self->{STORE}->{current_element} = undef;
121             } elsif ($tag eq 'tr') {
122 20 100       56 for my $key ( 'cells', $self->{ATTR}{classic} ? () : 'headers' ) {
123 35   100     81 my $data = $self->{STORE}{current_row}{$key} || [];
124 35   100     47 pop @{ $data } while @{ $data } && ! $data->[-1];
  67         191  
  32         53  
125             delete $self->{STORE}{current_row}{$key}
126 35 100       48 unless @{ $data };
  35         92  
127             }
128 20         27 $self->{STORE}->{current_row} = undef;
129 20         34 $self->{STORE}->{current_element} = undef;
130              
131             } elsif ($tag eq 'td') {
132 29         51 $self->{STORE}->{current_element} = undef;
133              
134             } elsif ($tag eq 'caption') {
135 2         6 $self->{STORE}->{current_element} = undef;
136              
137             } else {
138             ## Found a non-table related close tag. Push it into the currently-defined
139             ## td or th (if one exists).
140 20         35 my $elem = $self->{STORE}->{current_element};
141 20 100       37 if ($elem) {
142 4 50       9 $self->_debug('TEXT(tag) = ', $origtext) if $DEBUG;
143 4         6 $elem->{data} .= $origtext;
144             }
145              
146             }
147              
148 85 50       151 $self->_debug($origtext) if $DEBUG;
149              
150 85         290 return;
151             }
152              
153              
154             sub parse
155             {
156 5     5 1 18171 my ($self, $data) = @_;
157              
158 5 100       16 unless ( defined $data ) { # RT 7262
159 1         6 require Carp;
160 1         200 Carp::croak( 'Argument must be defined' );
161             }
162              
163             $self->{STORE} = {
164 4         14 stack => [],
165             };
166              
167 4         37 $self->SUPER::parse($data);
168              
169 4         8 my $tables = $self->{STORE}{tables};
170 4         9 delete $self->{STORE};
171              
172 4         23 return $tables;
173             }
174              
175              
176              
177              
178             sub _debug
179             {
180 0     0     my ( $self, @args ) = @_;
181 0           my $class = ref($self);
182 0           warn "$class: ", join( '', @args ), "\n";
183 0           return;
184             }
185              
186              
187             1;
188              
189              
190             __END__