package HTML::DOM::Element::Table;
use strict;
use warnings;
use HTML::DOM::Exception qw 'HIERARCHY_REQUEST_ERR INDEX_SIZE_ERR';
require HTML::DOM::Collection;
require HTML::DOM::Element;
#require HTML::DOM::NodeList::Magic;
our @ISA = qw'HTML::DOM::Element';
our $VERSION = '0.057';
sub caption {
my $old = ((my $self = shift)->content_list)[0];
undef $old unless $old and $old->tag eq 'caption';
if(@_) {
my $new = shift;
my $tag = (eval{$new->tag}||'');
$tag eq 'caption' or die new HTML'DOM'Exception
HIERARCHY_REQUEST_ERR,
$tag ? "A $tag element cannot be a table caption"
: "Not a valid table caption";
if ($old) {
$self->replaceChild($new, $old);
} else {
$self->unshift_content($new)
}
}
return $old || ();
}
sub tHead {
my $self = shift;
for($self->content_list) {
(my $tag = tag $_);
if($tag =~ /^t(?:head|body|foot)\z/) {
if(@_) {
my $new = shift;
my $new_tag = (eval{$new->tag}||'');
$new_tag eq 'thead' or die
new HTML'DOM'Exception
HIERARCHY_REQUEST_ERR,
$tag
? "A $new_tag element cannot be a table header"
: "Not a valid table header";
$_->${\qw[preinsert replace_with][$tag eq 'thead']}(
$new
);
$self->ownerDocument->_modified;
}
return $tag eq 'thead' ? $_:();
}
}
@_ and $self->appendChild(shift);
return;
}
sub tFoot {
my $self = shift;
for($self->content_list) {
(my $tag = tag $_);
if($tag =~ /^t(?:body|foot)\z/) {
if(@_) {
my $new = shift;
my $new_tag = (eval{$new->tag}||'');
$new_tag eq 'tfoot' or die
new HTML'DOM'Exception
HIERARCHY_REQUEST_ERR,
$tag
? "A $new_tag element cannot be a table footer"
: "Not a valid table footer";
$_->${\qw[preinsert replace_with][$tag eq 'tfoot']}(
$new
);
$self->ownerDocument->_modified;
}
return $tag eq 'tfoot' ? $_ : ();
}
}
@_ and $self->appendChild(shift);
return;
}
sub rows { # ~~~ I need to make this cache the resulting collection obj
my $self = shift;
if (wantarray) {
# I need a grep in order to exclude text nodes.
return grep tag $_ eq 'tr', map $_->content_list,
map $self->$_, qw/ tHead tBodies tFoot /;
}
else {
my $collection = HTML::DOM::Collection->new(
my $list = HTML::DOM::NodeList::Magic->new(
sub { grep tag $_ eq 'tr', map $_->content_list,
map $self->$_, qw/ tHead tBodies tFoot /; }
));
$self->ownerDocument-> _register_magic_node_list($list);
$collection;
}
}
sub tBodies { # ~~~ I need to make this cache the resulting collection obj
my $self = shift;
if (wantarray) {
return grep tag $_ eq 'tbody', $self->content_list;
}
else {
my $collection = HTML::DOM::Collection->new(
my $list = HTML::DOM::NodeList::Magic->new(
sub { grep tag $_ eq 'tbody', $self->content_list }
));
$self->ownerDocument-> _register_magic_node_list($list);
$collection;
}
}
sub align { lc shift->_attr('align' => @_) }
sub bgColor { shift->_attr('bgcolor' => @_) }
sub border { shift->_attr( border => @_) }
sub cellPadding { shift->_attr('cellpadding' => @_) }
sub cellSpacing { shift->_attr('cellspacing' => @_) }
sub frame { shift->_attr('frame' => @_) }
sub rules { lc shift->_attr('rules' => @_) }
sub summary { shift->_attr('summary' => @_) }
sub width { shift->_attr('width' => @_) }
sub createTHead {
my $self = shift;
my $th = $self->tHead;
$th and return $th;
my $inserted;
$th = $self->ownerDocument->createElement('thead');
for($self->content_list) {
next if tag $_ =~ /^c(?:aption|ol(?:group)?)\z/;
$_->preinsert($th), ++$inserted,
$self->ownerDocument->_modified, last
}
$self->appendChild($th) unless $inserted;
$th
}
sub deleteTHead {
my $self = shift;
($self->tHead||return)->delete; # ~~~ once I weaken upward refs, should I make this less destructive?
$self->ownerDocument->_modified;
return;
}
sub createTFoot {
my $self = shift;
my $tf = $self->tFoot;
$tf and return $tf;
my $inserted;
$tf = $self->ownerDocument->createElement('tfoot');
for($self->content_list) {
next if tag $_ =~ /^(?:c(?:aption|ol(?:group)?)|thead)\z/;
$_->preinsert($tf), ++$inserted,
$self->ownerDocument->_modified, last
}
$self->appendChild($tf) unless $inserted;
$tf
}
sub deleteTFoot {
my $self = shift;
($self->tFoot||return)->delete; # ~~~ once I weaken upward refs, should I make this less destructive?
$self->ownerDocument->_modified;
return;
}
sub createCaption {
my $self = shift; my $th;
$self->caption or
$self->unshift_content($th =
$self->ownerDocument->createElement('caption')),
$self->ownerDocument->_modified,
$th;
}
sub deleteCaption {
my $self = shift;
($self->caption||return)->delete; # ~~~ once I weaken upward refs, should I make this less destructive?
$self->ownerDocument->_modified;
return;
}
sub insertRow {
my $self = shift;
my $ix = shift;
my $len = (my $rows = $self->rows)->length;
my $row = $self->ownerDocument->createElement('tr');
if(!$len) { # worst case
if(my $tb = $self->tBodies->item(0)) {
$tb->appendChild($row);
}
else {
(my $tb = $self->ownerDocument
->createElement('tbody'))
->appendChild($row);
$self->appendChild($tb);
}
}
elsif($ix == -1 || $ix == $len) {
$rows->item(-1)->postinsert(
$row
);
$self->ownerDocument->_modified;
}
elsif($ix < $len && $ix >= 0) {
$rows->item($ix)->preinsert($row);
$self->ownerDocument->_modified
}
else {
die new HTML::DOM::Exception INDEX_SIZE_ERR,
"Index $ix is out of range"
}
return $row;
}
sub deleteRow {
my $self = shift;
($self->rows->item(shift)||return)->delete; # ~~~ once I weaken upward refs, should I make this less destructive?
$self->ownerDocument->_modified;
return;
}
=head1 NAME
HTML::DOM::Element::Table - A Perl class for representing 'table' elements in an HTML DOM tree
=head1 VERSION
Version 0.057
=head1 SYNOPSIS
use HTML::DOM;
$doc = HTML::DOM->new;
$elem = $doc->createElement('table');
$elem->tHead;
$elem->tBodies->[0];
$elem->createTFoot;
# etc
=head1 DESCRIPTION
This class represents 'table' elements in an HTML::DOM tree. It implements the HTMLTableElement DOM interface and inherits from L<HTML::DOM::Element>
(q.v.).
=head1 METHODS
In addition to those inherited from HTML::DOM::Element and its
superclasses, this class implements the following DOM methods:
=over 4
=item caption
=item tHead
=item tFoot
Each of these returns the table's corresponding element, if it exists, or
an empty list otherwise.
=item rows
Returns a collection of all table row elements, or a list in list context.
=item tBodies
Returns a collection of all 'tbody' elements, or a list in list context.
=item align
=item bgColor
=item border
=item cellPadding
=item cellSpacing
=item frame
=item rules
=item summary
=item width
These get (optionally set) the corresponding HTML attributes.
=item createTHead
Returns the table's 'thead' element, creating it if it doesn't exist.
=item deleteTHead
Deletes the table's 'thead' element.
=item createTFoot
Returns the table's 'tfoot' element, creating it if it doesn't exist.
=item deleteTFoot
Does what you would think.
=item createCaption
Returns the table's 'caption' element, creating it if it doesn't exist.
=item deleteCaption
Deletes the caption.
=item insertRow
Insert a new 'tr' element at the index specified by the first argument, and
returns that new row.
=item deleteRow
Deletes the row at the index specified by the first arg.
=back
=head1 SEE ALSO
L<HTML::DOM>
L<HTML::DOM::Element>
L<HTML::DOM::Element::Caption>
L<HTML::DOM::Element::TableColumn>
L<HTML::DOM::Element::TableSection>
L<HTML::DOM::Element::TR>
L<HTML::DOM::Element::TableCell>
=cut
# ------- HTMLTableCaptionElement interface ---------- #
package HTML::DOM::Element::Caption;
our $VERSION = '0.057';
our @ISA = 'HTML::DOM::Element';
*align = \&HTML::DOM::Element::Table::align;
# ------- HTMLTableColElement interface ---------- #
package HTML::DOM::Element::TableColumn;
our $VERSION = '0.057';
our @ISA = 'HTML::DOM::Element';
*align = \&HTML::DOM::Element::Table::align;
sub ch { shift->_attr('char' => @_) }
sub chOff { shift->_attr( charoff => @_) }
sub span { shift->_attr('span' => @_) }
sub vAlign { lc shift->_attr('valign' => @_) }
sub width { shift->_attr('width' => @_) }
# ------- HTMLTableSectionElement interface ---------- #
package HTML::DOM::Element::TableSection;
our $VERSION = '0.057';
our @ISA = 'HTML::DOM::Element';
*align = \&HTML::DOM::Element::Table::align;
*ch = \&HTML::DOM::Element::TableColumn::ch;
*chOff = \&HTML::DOM::Element::TableColumn::chOff;
*vAlign = \&HTML::DOM::Element::TableColumn::vAlign;
sub rows { # ~~~ I need to make this cache the resulting collection obj
my $self = shift;
if (wantarray) {
# I need a grep in order to exclude text nodes.
return grep tag $_ eq 'tr', $self->content_list,
}
else {
my $collection = HTML::DOM::Collection->new(
my $list = HTML::DOM::NodeList::Magic->new(
sub { grep tag $_ eq 'tr', $self->content_list; }
));
$self->ownerDocument-> _register_magic_node_list($list);
$collection;
}
}
sub insertRow {
my $self = shift;
my $ix = shift||0;
my $len = (my $rows = $self->rows)->length;
my $row = $self->ownerDocument->createElement('tr');
if(!$len) {
$self->appendChild($row);
}
elsif($ix == -1 || $ix == $len) {
$rows->item(-1)->postinsert(
$row
);
$self->ownerDocument->_modified;
}
elsif($ix < $len && $ix >= 0) {
$rows->item($ix)->preinsert($row);
$self->ownerDocument->_modified;
}
else {
die new HTML::DOM::Exception
HTML::DOM::Exception::INDEX_SIZE_ERR,
"Index $ix is out of range"
}
return $row;
}
*deleteRow = \&HTML::DOM::Element::Table::deleteRow;
# ------- HTMLTableRowElement interface ---------- #
package HTML::DOM::Element::TR;
our $VERSION = '0.057';
our @ISA = 'HTML::DOM::Element';
sub rowIndex {
my $self = shift;
my $ix = 0;
for($self->look_up(_tag => 'table')->rows){
return $ix if $self == $_;
$ix++
}
die "Internal error in HTML::DOM::Element::TR::rowIndex: " .
"This table row is not inside the table it is inside. " .
"Please report this bug."
}
sub sectionRowIndex {
my $self = shift;
my $parent = $self->parent;
while(!$parent->isa('HTML::DOM::Element::TableSection')) {
# If we get here, there is probably something wrong, should
# I just throw an error instead?
$parent = $parent->parent;
}
my $ix = 0;
for($parent->rows){
return $ix if $self == $_;
$ix++
}
die "Internal error in HTML::DOM::Element::TR::sectionRowIndex: " .
"This table row is not inside the table section it is " .
"inside. Please report this bug."
}
sub cells { # ~~~ I need to make this cache the resulting collection obj
my $self = shift;
if (wantarray) {
# I need a grep in order to exclude text nodes.
return grep tag $_ =~ /^t[hd]\z/, $self->content_list,
}
else {
my $collection = HTML::DOM::Collection->new(
my $list = HTML::DOM::NodeList::Magic->new(
sub { grep tag $_ =~ /^t[hd]\z/, $self->content_list; }
));
$self->ownerDocument-> _register_magic_node_list($list);
$collection;
}
}
*align = \&HTML::DOM::Element::Table::align;
*bgColor = \&HTML::DOM::Element::Table::bgColor;
*ch = \&HTML::DOM::Element::TableColumn::ch;
*chOff = \&HTML::DOM::Element::TableColumn::chOff;
*vAlign = \&HTML::DOM::Element::TableColumn::vAlign;
sub insertCell {
my $self = shift;
my $ix = shift||0;
my $len = (my $cels = $self->cells)->length;
my $cel = $self->ownerDocument->createElement('td');
if(!$len) {
$self->appendChild($cel);
}
elsif($ix == -1 || $ix == $len) {
$cels->item(-1)->postinsert(
$cel
);
$self->ownerDocument->_modified;
}
elsif($ix < $len && $ix >= 0) {
$cels->item($ix)->preinsert($cel);
$self->ownerDocument->_modified;
}
else {
die new HTML::DOM::Exception
HTML::DOM::Exception::INDEX_SIZE_ERR,
"Index $ix is out of range"
}
return $cel;
}
sub deleteCell {
my $self = shift;
($self->cells->item(shift)||return)->delete; # ~~~ once I weaken upward refs, should I make this less destructive?
$self->ownerDocument->_modified;
return;
}
# ------- HTMLTableCellElement interface ---------- #
package HTML::DOM::Element::TableCell;
our $VERSION = '0.057';
our @ISA = 'HTML::DOM::Element';
sub cellIndex {
my $self = shift;
my $ix = 0;
for($self->parent->cells){
return $ix if $self == $_;
$ix++
}
die "Internal error in HTML::DOM::Element::TR::rowIndex: " .
"This table row is not inside the table it is inside. " .
"Please report this bug."
}
sub abbr { shift->_attr('abbr' => @_) }
*align = \&HTML::DOM::Element::Table::align;
sub axis { shift->_attr('axis' => @_) }
*bgColor = \&HTML::DOM::Element::Table::bgColor;
*ch = \&HTML::DOM::Element::TableColumn::ch;
*chOff = \&HTML::DOM::Element::TableColumn::chOff;
sub colSpan { shift->_attr('colspan' => @_) }
sub headers { shift->_attr('headers' => @_) }
sub height { shift->_attr('height' => @_) }
sub noWrap { shift->_attr(nowrap => @_ ? $_[0] ? 'nowrap' : undef : ()) }
sub rowSpan { shift->_attr('rowspan' => @_) }
sub scope { lc shift->_attr('scope' => @_) }
*vAlign = \&HTML::DOM::Element::TableColumn::vAlign;
*width = \&HTML::DOM::Element::Table::width;
Copyright 2K16 - 2K18 Indonesian Hacker Rulez