1#!/usr/bin/perl -T 2 3# The HTMLCollection interface 4 5use strict; use warnings; 6 7use Test::More tests => 32; 8 9 10# -------------------------# 11# Tests 1-2: load the modules 12 13BEGIN { use_ok 'HTML::DOM::Collection'; } 14BEGIN { use_ok 'HTML::DOM::NodeList'; } 15 16# -------------------------# 17# Test 3: constructor 18 19my (@array); 20 21my $col = new HTML::DOM::Collection ( 22 new HTML::DOM::NodeList \@array 23); 24isa_ok $col, 'HTML::DOM::Collection'; 25 26{package _Elem; 27 sub id { defined ${$_[0]}[0] ? reverse ${$_[0]}[0] : undef} 28 sub attr { return ${$_[0]}[0] if $_[1] eq 'name'} 29 sub tag { 'a' } } 30@array = map +(bless[$_],'_Elem'), 31 qw'Able was I ere I saw Elba', undef; 32 33# -------------------------# 34# Tests 4-15: access contents 35 36is +(item $col 3)->id, 'ere', 'item'; 37is $$col[3]->id, 'ere', 'array overloading'; 38is $col->length, 8, 'length'; 39is $col->namedItem('saw')->id, 'saw', 'namedItem (id overrides name)'; 40is $col->namedItem('Able')->id, 'elbA', 41 'namedItem (name works nonetheless)'; 42is $col->namedItem('I'), $col->[2], 43 'The first item is chosen if two share the same name.'; 44is $col->{Elba}, $col->namedItem('Elba'), 'hash overloading'; 45 46ok exists $col->{Elba}, 'exists'; 47ok!exists $col->{eLba}, 'doesn\'t exist'; 48is_deeply[keys %$col], [qw[elbA saw I ere was ablE Able Elba]], 'keys'; 49# implementation detail (subject to change): FIRSTKEY and NEXTKEY iterate 50# through the items checking the IDs first, then they go through the list 51# again, getting names. 52ok %$col, 'hash in scalar context'; 53{ 54 my @copy = @array ; @array = (); 55 ok!%$col, 'empty hash in scalar context'; 56 @array = @copy; 57} 58 59# -------------------------# 60# Tests 16-17: access contents after modification 61 62splice @array, 1,1; 63 64is +(item $col 2)->id, 'ere', 'item after modification'; 65is +(namedItem $col 'saw')->attr('name'), 'saw', 66 'namedItem afer modification'; 67 68# -------------------------# 69# Tests 13-31: different types of named elements 70 71sub _elem2::id { } 72sub _elem2::attr { $_[0][1] } 73sub _elem2::tag { $_[0][0] } 74 75{ 76 my @nameable_elems = qw/ button textarea applet select form frame 77 iframe img a input object map param meta/; 78 @array = map bless([$_ => "$_-1"], '_elem2'),@nameable_elems; 79 my $count = 0; 80 is $col->namedItem("$_-1"), $array[$count++], 81 "namedItem can return a" . 'n' x /^[aio]/ . " $_ element" 82 for @nameable_elems; 83} 84 85# -------------------------# 86# Test 32: rubbish disposal 87 88use Scalar::Util 'weaken'; 89weaken $col; 90is $col, undef, 'rubbish disposal'; 91 92