File Coverage

blib/lib/HTML/DOM/Collection.pm

Criterion	Covered	Total	%
statement	58	62	93.5
branch	15	18	83.3
condition	8	9	88.8
subroutine	18	19	94.7
pod	3	5	60.0
total	102	113	90.2

package HTML::DOM::Collection;

use strict;
use warnings;

use Scalar::Util 'weaken';

our $VERSION = '0.056';

# Internals: \[$nodelist, $tie]

# Field constants:
sub nodelist(){0}
sub tye(){1}
sub seen(){2}     # whether this key has been seen
sub position(){3} # current (array) position used by NEXTKEY
sub ids(){4}      # whether we are iterating through ids
#  Number 5 is taken by ::Options (inside Element/Form.pm).
{ no warnings 'misc';
  undef &nodelist; undef &tye; undef &seen; undef &position;
}

use overload fallback => 1,
'%{}' => sub {
	my $self = shift;
	$$$self[tye] or
		weaken(tie %{ $$$self[tye] }, __PACKAGE__, $self),
		$$$self[tye];
},
'@{}' => sub { ${+shift}->[nodelist] };


sub new {
	bless \[$_[1]], shift;
}

my %NameableElements = map +($_ => 1), qw/
	a area object param applet input select textarea button frame
	iframe meta form img map
/;

sub namedItem {
	my($self, $name) = @_;
	my $list = $$self->[nodelist];
	my $named_elem; my $elem;
	for(0..$list->length - 1) {
		no warnings 'uninitialized';
		($elem = $list->item($_))->id eq $name and return $elem;
		exists $NameableElements{$elem->tag} and
			$elem->attr('name') eq $name and
			$named_elem = $elem;
	}
	$named_elem ||()
}

# Delegated methosd
for (qw/length item/) {
	eval "sub $_ { \${+shift}->[" . nodelist . "]->$_(\@_) }"
}


sub TIEHASH { $_[1] }
sub FETCH     { $_[0]->namedItem($_[1]) }
sub EXISTS    { $_[0]->namedItem($_[1]) } # nodes are true, undef is false
sub FIRSTKEY {
	my $self = shift;
	(my $guts = $$self)->[seen] = {};
	my($id,$item);
	$guts->[ids] = 1;
	for (0..$self->length - 1) {
		defined($id = ($item = $self->item($_))->id)
			and ++$guts->[seen]{$id}, $guts->[position] = $_,
			    return($id);
	}
	# If none of the items has an id...
	$guts->[ids] = 0;
	for (0..$self->length - 1) {
		defined($id = ($item = $self->item($_))->attr('name'))
			and ++$guts->[seen]{$id}, $guts->[position] = $_,
			    return($id);
	}
	return; # empty list
}

sub NEXTKEY{
	my $self = shift;
	my $guts = $$self;
	my($id,$item);
	if($guts->[ids]) {
		for ($guts->[position]..$self->length - 1) {
			defined($id = ($item = $self->item($_))->id)
				and !$guts->[seen]{$id}++
				and $guts->[position] = $_,
				    return($id);
		}
	}
	# If we've exhausted all ids...
	$guts->[ids] = 0;
	for (0..$self->length - 1) {
		defined($id = ($item = $self->item($_))->attr('name'))
			and !$guts->[seen]{$id}++
			and $guts->[position] = $_,
			    return($id);
	}
	return;
}

sub SCALAR {
	defined FIRSTKEY @_;
}

sub DDS_freeze { my $self = shift; delete $$$self[tye]; $self }

1

__END__