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   1219 use strict;
  2         9  
  2         60  
4 2     2   26 use warnings;
  2         4  
  2         61  
5              
6 2     2   995 use parent qw{ HTML::Parser };
  2         618  
  2         11  
7              
8             our $VERSION = '0.305';
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 8514 my ( $class, %arg ) = @_;
18 3         8 my $classic = delete $arg{classic};
19 3         26 my $self = $class->SUPER::new( %arg );
20 3 50       211 $self->{ATTR}{classic} = defined $classic ? $classic : $CLASSIC;
21 3         10 return $self;
22             }
23              
24             sub classic
25             {
26 1     1 1 11 my ( $self ) = @_;
27 1         9 return $self->{ATTR}{classic};
28             }
29              
30             sub start
31             {
32             # my ($self, $tag, $attr, $attrseq, $origtext) = @_;
33 85     85 1 181 my ($self, $tag, $attr, undef, $origtext) = @_;
34              
35 85         130 $tag = lc($tag);
36              
37             # Store the incoming details in the current 'object'.
38 85 100       252 if ($tag eq 'table') {
    100          
    100          
    100          
    100          
39 6         11 my $table = $attr;
40 6         19 push @{ $self->{STORE}{stack} }, {
41 6         12 map { $_ => $self->{STORE}{$_} } @stacked };
  18         69  
42 6         11 push @{$self->{STORE}->{tables}}, $table;
  6         17  
43 6         15 $self->{STORE}->{current_table} = $table;
44 6         10 $self->{STORE}->{current_row} = undef;
45 6         11 $self->{STORE}->{current_element} = undef;
46              
47             } elsif ($tag eq 'th') {
48 8         13 my $th = $attr;
49 8         12 push @{$self->{STORE}->{current_table}->{headers}}, $th;
  8         20  
50 8 100       21 unless ( $self->{ATTR}{classic} ) {
51 7         8 push @{$self->{STORE}->{current_row}->{cells}}, undef;
  7         17  
52 7         10 push @{$self->{STORE}->{current_row}->{headers}}, $th;
  7         15  
53             }
54 8         13 $self->{STORE}->{current_element} = $th;
55              
56             } elsif ($tag eq 'tr') {
57 20         24 my $tr = $attr;
58 20         27 push @{$self->{STORE}->{current_table}->{rows}}, $tr;
  20         48  
59 20         34 $self->{STORE}->{current_row} = $tr;
60 20         31 $self->{STORE}->{current_element} = $tr;
61              
62             } elsif ($tag eq 'td') {
63 29         41 my $td = $attr;
64 29         42 push @{$self->{STORE}->{current_row}->{cells}}, $td;
  29         69  
65 29 100       61 unless ( $self->{ATTR}{classic} ) {
66 25         33 push @{$self->{STORE}->{current_row}->{headers}}, undef;
  25         51  
67             }
68 29         46 $self->{STORE}->{current_element} = $td;
69              
70             } elsif ($tag eq 'caption') {
71 2         5 my $cap = $attr;
72 2         3 $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         37 my $elem = $self->{STORE}->{current_element};
79 20 100       42 if ($elem) {
80 4 50       19 $self->_debug('TEXT(tag) = ', $origtext) if $DEBUG;
81 4         12 $elem->{data} .= $origtext;
82             }
83              
84             }
85              
86 85 50       147 $self->_debug($origtext) if $DEBUG;
87              
88 85         327 return;
89             }
90              
91              
92              
93             sub text
94             {
95 113     113 1 269 my ($self, $text) = @_;
96 113         206 my $elem = $self->{STORE}->{current_element};
97 113 100       223 if (!$elem) {
98 69         304 return;
99             }
100              
101 44 50       79 $self->_debug('TEXT = ', $text) if $DEBUG;
102 44         94 $elem->{data} .= $text;
103              
104 44         153 return;
105             }
106              
107              
108              
109             sub end
110             {
111 85     85 1 169 my ($self, $tag, $origtext) = @_;
112 85         153 $tag = lc($tag);
113              
114             # Turn off the current object
115 85 100       231 if ($tag eq 'table') {
    100          
    100          
    100          
    100          
116 6   50     7 my $prev = pop @{ $self->{STORE}{stack} } || [];
117 6         30 $self->{STORE}{$_} = $prev->{$_} for @stacked;
118              
119             } elsif ($tag eq 'th') {
120 8         11 $self->{STORE}->{current_element} = undef;
121             } elsif ($tag eq 'tr') {
122 20 100       66 for my $key ( 'cells', $self->{ATTR}{classic} ? () : 'headers' ) {
123 35   100     85 my $data = $self->{STORE}{current_row}{$key} || [];
124 35   100     45 pop @{ $data } while @{ $data } && ! $data->[-1];
  67         197  
  32         49  
125             delete $self->{STORE}{current_row}{$key}
126 35 100       50 unless @{ $data };
  35         91  
127             }
128 20         31 $self->{STORE}->{current_row} = undef;
129 20         31 $self->{STORE}->{current_element} = undef;
130              
131             } elsif ($tag eq 'td') {
132 29         55 $self->{STORE}->{current_element} = undef;
133              
134             } elsif ($tag eq 'caption') {
135 2         5 $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         30 my $elem = $self->{STORE}->{current_element};
141 20 100       42 if ($elem) {
142 4 50       10 $self->_debug('TEXT(tag) = ', $origtext) if $DEBUG;
143 4         5 $elem->{data} .= $origtext;
144             }
145              
146             }
147              
148 85 50       157 $self->_debug($origtext) if $DEBUG;
149              
150 85         287 return;
151             }
152              
153              
154             sub parse
155             {
156 5     5 1 18966 my ($self, $data) = @_;
157              
158 5 100       20 unless ( defined $data ) { # RT 7262
159 1         7 require Carp;
160 1         223 Carp::croak( 'Argument must be defined' );
161             }
162              
163             $self->{STORE} = {
164 4         17 stack => [],
165             };
166              
167 4         65 $self->SUPER::parse($data);
168              
169 4         7 my $tables = $self->{STORE}{tables};
170 4         12 delete $self->{STORE};
171              
172 4         32 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__