File Coverage

blib/lib/HTML/DOM/Element/Table.pm

Criterion	Covered	Total	%
statement	192	200	96.0
branch	74	86	86.0
condition	36	44	81.8
subroutine	50	50	100.0
pod	22	22	100.0
total	374	402	93.0

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
(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

L

L

L

L

L

L

=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;