File Coverage

blib/lib/Data/TableReader/Decoder/HTML.pm

Criterion	Covered	Total	%
statement	108	117	92.3
branch	35	58	60.3
condition	9	13	69.2
subroutine	22	22	100.0
pod	2	2	100.0
total	176	212	83.0

outside any

line	stmt	bran	cond	sub	pod	time	code
1							package Data::TableReader::Decoder::HTML;
2							$Data::TableReader::Decoder::HTML::VERSION = '0.020';
3	1			1		213322	use Moo 2;
	1					11249
	1					7
4	1			1		1983	use Try::Tiny;
	1					2
	1					74
5	1			1		8	use Carp;
	1					2
	1					56
6	1			1		693	use IO::Handle;
	1					12723
	1					73
7	1			1		1055	use HTML::Parser;
	1					7594
	1					1356
8							extends 'Data::TableReader::Decoder';
9
10							# ABSTRACT: Access the tables of an HTML document
11
12
13							has _tables => ( is => 'lazy' );
14							sub parse {
15	2			2	1	409067	shift->_tables;
16	2					31	return 1;
17							}
18
19							sub _build__tables {
20	3			3		54	my $self= shift;
21							# TODO: determine encoding from BOM, or from meta-equiv while parsing...
22	3					24	binmode $self->file_handle;
23	3					16	return $self->_parse_html_tables($self->file_handle);
24							}
25
26							sub _parse_html_tables {
27	3			3		10	my ($self, $handle)= @_;
28							# These variables track the state of the HTML parse.
29							# cur_row is only defined when we are in a table row, and $cur_cell
30							# is a scalar ref only defined when we are in a cell.
31	3					8	my (@tables, $cur_table, $cur_row, $cur_cell);
32	3					6	my $nested_tables= 0;
33	3					7	my $ignore_all= 0;
34
35							my $tag_start= sub {
36	114	50		114		767	next if $ignore_all;
37	114					282	my ($tagname, $attr)= (uc $_[0], $_[1]);
38	114	100	100			449	if ($tagname eq 'TABLE') {
		100
		100
39	6	50				13	if ($cur_table) {
40	0					0	$self->_log->('warn','tables within tables are currently returned as a single cell value');
41	0					0	$nested_tables++;
42	0					0	$ignore_all++;
43							}
44							else {
45	6					30	push @tables, ($cur_table= []);
46							}
47							}
48							elsif ($tagname eq 'TR') {
49	18	50				59	$cur_table or croak "found

"; before end of previous row'); ");

$cur_row and $self->_log->('warn', 'found

push @$cur_table, ($cur_row= []);

}

elsif ($tagname eq 'TD' or $tagname eq 'TH') {

169

$cur_table or croak "found <$tagname> outside any "; "; without matching "); while still in

55	81	50			160	$cur_row or croak "found <$tagname> outside any
56	81	50			154	$cur_cell and $self->_log->('warn', "found <$tagname> before previous ");
57	81				196	push @$cur_row, '';
58	81				292	$cur_cell= \$cur_row->[-1];
59						}
60	3				22	};
61						my $content= sub {
62	129			129	280	my ($text)= @_;
63	129	100	33		364	if ($cur_cell) {
		50
64	81				251	$$cur_cell .= $text
65						}
66						elsif ($cur_row && $text =~ /\S/) {
67	0				0	$self->_log->('warn', "Encountered text within a row but not in a cell: '$text'");
68						}
69	3				16	};
70						my $tag_end= sub {
71	114			114	278	my ($tagname)= (uc($_[0]));
72	114	50	100		438	if ($ignore_all) {
		100
		100
		100
73	0	0			0	if ($tagname eq 'TABLE') {
74	0				0	--$nested_tables;
75	0	0			0	$ignore_all= 0 if $nested_tables <= 0;
76						}
77						}
78						elsif ($tagname eq 'TD' or $tagname eq 'TH') {
79	81	50			229	$cur_cell or $self->_log->('warn', "Found without matching <$tagname>");
80	81				220	$cur_cell= undef;
81						}
82						elsif ($tagname eq 'TR') {
83	18	50			38	$cur_row or $self->_log->('warn', "Found
84	18	50			47	$cur_cell and $self->_log->('warn', "Found
");
85	18				29	$cur_row= undef;
86	18				51	$cur_cell= undef;
87						}
88						elsif ($tagname eq 'TABLE') {
89	6	50			15	$cur_table or $self->_log->('warn', "Found

without matching ");

$cur_row and $self->_log->('warn', "Found

while still in

$cur_cell and $self->_log->('warn', "Found

while still in "); 92 6 12 $cur_table= undef; 93 6 9 $cur_row= undef; 94 6 17 $cur_cell= undef; 95 } 96 3 15 }; 97 98 3 38 HTML::Parser->new( 99 api_version => 3, 100 start_h => [ $tag_start, 'tagname,attr' ], 101 text_h => [ $content, 'dtext' ], 102 end_h => [ $tag_end, 'tagname' ] 103 )->parse_file($handle); 104 105 3 50 31 $nested_tables == 0 or $self->_log->('warn', "Found EOF while expecting tag"); 106 3 76 return \@tables; 107 } 108 109 110 sub iterator { 111 3 3 1 5694 my $self= shift; 112 3 114 my ($tables, $table_i, $row_i)= ($self->_tables, 0, 0); 113 3 50 30 my $table= $tables->[$table_i] || []; 114 3 8 my $n_records= 0; $n_records += @$_ for @$tables; 3 12 115 return Data::TableReader::Decoder::HTML::_Iter->new( 116 sub { 117 10 50 10 5420 my $row= $table->[$row_i] 118 or return undef; 119 10 21 $row_i++; 120 10 50 50 my @r= $_[0]? @{$row}[ @{$_[0]} ] : @$row; # optional slice argument 0 0 0 0 121 10 57 return \@r; 122 }, 123 { 124 3 70 table => \$table, 125 table_i => \$table_i, 126 row_i => \$row_i, 127 total_records => $n_records, 128 table_record_ofs => 0, 129 tables => $tables, 130 } 131 ); 132 } 133 134 # If you need to subclass this iterator, don't. Just implement your own. 135 # i.e. I'm not declaring this implementation stable, yet. 136 1 1 662 use Data::TableReader::Iterator; 1 719 1 68 137 1 1 736 BEGIN { @Data::TableReader::Decoder::HTML::_Iter::ISA= ('Data::TableReader::Iterator'); } 138 139 sub Data::TableReader::Decoder::HTML::_Iter::position { 140 6 6 29 my $f= shift->_fields; 141 6 48 'table '.${ $f->{table_i} }.' row '.${ $f->{row_i} }; 6 14 6 36 142 } 143 144 sub Data::TableReader::Decoder::HTML::_Iter::row { 145 3 3 12 ${ shift->_fields->{row_i} }; 3 12 146 } 147 148 sub Data::TableReader::Decoder::HTML::_Iter::dataset_idx { 149 5 5 1968 ${ shift->_fields->{table_i} } 5 18 150 } 151 152 sub Data::TableReader::Decoder::HTML::_Iter::progress { 153 2 2 2144 my $f= shift->_fields; 154 return ! $f->{total_records}? 0 155 2 50 17 : (( $f->{table_record_ofs} + ${$f->{row_i}} ) / $f->{total_records}); 2 15 156 } 157 158 sub Data::TableReader::Decoder::HTML::_Iter::tell { 159 2 2 498 my $f= shift->_fields; 160 2 42 return [ ${$f->{table_i}}, ${$f->{row_i}} ]; 2 31 2 9 161 } 162 163 sub Data::TableReader::Decoder::HTML::_Iter::seek { 164 4 4 2097 my ($self, $to)= @_; 165 4 15 my $f= $self->_fields; 166 4 20 ${$f->{table_i}}= $to->[0]; 4 12 167 4 9 ${$f->{row_i}}= $to->[1]; 4 9 168 4 50 9 ${$f->{table}}= $f->{tables}[${$f->{table_i}}] || []; 4 9 169 # re-calculate table_record_ofs 170 4 10 my $t= 0; $t += @$_ for @{$f->{tables}}[0 .. $to->[1]-1]; 4 11 4 32 171 4 9 $f->{table_record_ofs}= $t; 172 4 37 1; 173 } 174 175 sub Data::TableReader::Decoder::HTML::_Iter::next_dataset { 176 3 3 1037 my $f= $_[0]->_fields; 177 3 100 17 return 0 if ${$f->{table_i}} >= $#{$f->{tables}}; 3 7 3 19 178 2 5 $_[0]->seek([ ${$f->{table_i}}+1, 0 ]); 2 9 179 } 180 181 1; 182 183 __END__