—

              
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.036';
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;
}
HideShow 117 lines of Pod
=head1 NAME
HTML::DOM::Element::Table - A Perl class for representing 'table' elements in an HTML DOM tree
=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.036';
our @ISA = 'HTML::DOM::Element';
*align = \&HTML::DOM::Element::Table::align;
# ------- HTMLTableColElement interface ---------- #
package HTML::DOM::Element::TableColumn;
our $VERSION = '0.036';
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.036';
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.036';
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.036';
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'   => @_) }
sub rowSpan  { shift->_attr('rowspan'  => @_) }
sub scope    { lc shift->_attr('scope'    => @_) }
*vAlign  = \&HTML::DOM::Element::TableColumn::vAlign;
*width   = \&HTML::DOM::Element::Table::width;