our
$VERSION
=
'1.00'
;
has
[
qw(current_tables nested caption_selectors)
] => (
is
=>
'rw'
,
lazy
=> 1,
clearer
=> 1,
default
=>
sub
{ [] },
);
has
[
qw(current_table current_element selected)
] => (
is
=>
'rw'
,
lazy
=> 1,
clearer
=> 1,
);
has
options
=> (
is
=>
'ro'
,
lazy
=> 1,
builder
=> 1,
);
sub
has_caption_selector {
return
scalar
@{
$_
[0]->caption_selectors } ? 1 : 0 }
sub
count_nested {
return
scalar
@{
$_
[0]->nested }; }
sub
has_nested {
return
$_
[0]->count_nested ? 1 : 0; }
sub
get_last_nested {
return
$_
[0]->nested->[
$_
[0]->count_nested - 1 ]; }
sub
clear_last_nested {
return
delete
$_
[0]->nested->[
$_
[0]->count_nested - 1 ];
}
sub
all_current_tables {
return
@{
$_
[0]->current_tables }; }
sub
count_current_tables {
return
scalar
@{
$_
[0]->current_tables }; }
sub
current_or_nested {
return
$_
[0]->has_nested ?
$_
[0]->get_last_nested :
$_
[0]->current_table;
}
sub
parse {
my
(
$self
,
$data
) =
@_
;
$self
->SUPER::parse(
$data
);
return
$self
->current_tables;
}
sub
parse_file {
my
(
$self
,
$file
) =
@_
;
$self
->SUPER::parse_file(
$file
);
return
$self
->current_tables;
}
sub
start {
my
(
$self
,
$tag
,
$attr
,
$attrseq
,
$origtext
) =
@_
;
if
(
$self
->current_element &&
$attr
->{href}) {
push
@{
$self
->current_element->links },
$attr
->{href};
}
$tag
=
lc
$tag
;
if
(
my
$option
=
$self
->options->{
$tag
} ) {
my
$table
=
$self
->current_or_nested;
my
$action
=
$option
->{add};
my
$element
=
$self
->
$action
(
$attr
,
$table
);
return
$self
->current_element(
$element
);
}
if
(
$self
->has_caption_selector ) {
foreach
my
$selector
( @{
$self
->caption_selectors }) {
if
(
$selector
eq
$tag
) {
return
$self
->selected(
$attr
);
}
for
my
$field
(
qw/id class/
) {
my
$val
=
$attr
->{
$field
};
next
unless
$val
;
if
(
$val
=~ m/
$selector
/ixms) {
return
$self
->selected(
$attr
);
}
}
}
}
return
;
}
sub
text {
my
(
$self
,
$text
) =
@_
;
if
(
my
$elem
=
$self
->current_element ) {
if
(
$text
=~ m{\S+}xms ) {
$text
=~ s{^\s+|\s+$}{}g;
push
@{
$elem
->data },
$text
;
}
}
if
(
my
$selected
=
$self
->selected) {
if
(
$text
=~ m{\S+}xms ) {
$selected
->{text} =
$text
;
$self
->selected(
$selected
);
}
}
return
;
}
sub
end {
my
(
$self
,
$tag
,
$origtext
) =
@_
;
$tag
=
lc
$tag
;
if
(
my
$option
=
$self
->options->{
$tag
} ) {
my
$table
=
$self
->current_or_nested;
if
(
my
$action
=
$option
->{
close
} ) {
my
$element
=
$self
->
$action
(
$table
);
}
}
return
;
}
sub
_build_options {
return
{
table
=> {
add
=>
'_add_table'
,
close
=>
'_close_table'
,
},
th
=> {
add
=>
'_add_header'
,
},
tr
=> {
add
=>
'_add_row'
,
close
=>
'_close_row'
,
},
td
=> {
add
=>
'_add_cell'
,
},
caption
=> {
add
=>
'_add_caption'
}
};
}
sub
_add_header {
my
(
$self
,
$attr
,
$table
) =
@_
;
my
$header
=
$table
->add_header(
$attr
);
$table
->get_last_row->header(
$header
);
return
$header
;
}
sub
_add_row {
my
(
$self
,
$attr
,
$table
) =
@_
;
my
$row
=
$table
->add_row(
$attr
);
return
$row
;
}
sub
_add_cell {
my
(
$self
,
$attr
,
$table
) =
@_
;
my
$cell
=
$table
->get_last_row->add_cell(
$attr
);
$table
->parse_to_column(
$cell
);
return
$cell
;
}
sub
_add_caption {
my
(
$self
,
$attr
,
$table
) =
@_
;
my
$caption
=
$table
->add_caption(
$attr
);
return
$caption
;
}
sub
_add_table {
my
(
$self
,
$attr
,
$table
) =
@_
;
my
$element
= HTML::TableContent::Table->new(
$attr
);
if
(
defined
$table
&&
$table
->isa(
'HTML::TableContent::Table'
) ) {
if
(
$self
->has_nested ) {
push
@{
$self
->current_table->nested },
$element
;
}
push
@{
$self
->nested },
$element
;
push
@{
$table
->nested },
$element
;
push
@{
$table
->get_last_row->get_last_cell->nested },
$element
;
}
else
{
if
(
my
$caption
=
$self
->selected ){
$element
->add_caption(
$caption
);
$self
->clear_selected;
}
$self
->current_table(
$element
);
}
}
sub
_close_table {
my
(
$self
,
$table
) =
@_
;
if
(
$self
->has_nested ) {
return
$self
->clear_last_nested;
}
else
{
push
@{
$self
->current_tables },
$self
->current_table;
$self
->clear_current_element;
return
$self
->clear_current_table;
}
}
sub
_close_row {
my
(
$self
,
$table
) =
@_
;
my
$row
=
$table
->get_last_row;
if
(
$row
->header ) {
$table
->clear_last_row;
my
$index
= 0;
foreach
my
$cell
(
$row
->all_cells ) {
my
$row
=
$table
->rows->[
$index
];
if
(
defined
$row
) {
push
@{
$row
->cells },
$cell
;
}
else
{
my
$new_row
=
$table
->add_row({});
push
@{
$new_row
->cells },
$cell
;
}
$index
++;
}
}
elsif
(
$row
->cell_count == 0 ) {
$table
->clear_last_row;
}
return
;
}
1;