jasons 2002/08/27 12:20:01
Added: perl/t DOMAttr.t DOMDocument.t DOMElement.t DOMEntity.t
DOMException.t DOMNamedNodeMap.t DOMNode.t
DOMNodeIterator.t DOMNodeList.t DOMTreeWalker.t
DOMWriter.t
Log:
renamed old DOM_ tests
Revision Changes Path
1.1 xml-xerces/perl/t/DOMAttr.t
Index: DOMAttr.t
===================================================================
# Before `make install' is performed this script should be runnable
# with `make test'. After `make install' it should work as `perl
# DOMAttr.t'
######################### We start with some black magic to print on failure.
# Change 1..1 below to 1..last_test_to_print .
# (It may become useful if the test is moved to ./t subdirectory.)
BEGIN { $| = 1; print "1..6\n"; }
END {print "not ok 1\n" unless $loaded;}
use Carp;
# use blib;
use utf8;
use XML::Xerces;
use lib 't';
use TestUtils qw(result is_object $DOM $PERSONAL_FILE_NAME);
use vars qw($i $loaded);
use strict;
$loaded = 1;
$i = 1;
result($loaded);
######################### End of black magic.
# Insert your test code below (better if it prints "ok 13"
# (correspondingly "not ok 13") depending on the success of chunk 13
# of the test code):
eval{$DOM->parse($PERSONAL_FILE_NAME)};
XML::Xerces::error($@) if $@;
my $doc = $DOM->getDocument();
my $doctype = $doc->getDoctype();
my @persons = $doc->getElementsByTagName('person');
result(is_object($persons[0])
&& $persons[0]->isa('XML::Xerces::DOMElement')
);
# test getting the attribute node
my $attr = $persons[0]->getAttributeNode('id');
result(is_object($attr)
&& $attr->isa('XML::Xerces::DOMAttr')
);
# test getting the attribute value
result($attr->getValue() eq $persons[0]->getAttribute('id'));
# test that we can use integers and floats as values for setting attribtes
eval {$attr->setValue(3)};
result(!$@);
eval {$attr->setValue(.03)};
result(!$@);
1.1 xml-xerces/perl/t/DOMDocument.t
Index: DOMDocument.t
===================================================================
# Before `make install' is performed this script should be runnable
# with `make test'. After `make install' it should work as `perl
# DOMDocument.t'
######################### We start with some black magic to print on failure.
# Change 1..1 below to 1..last_test_to_print .
# (It may become useful if the test is moved to ./t subdirectory.)
BEGIN { $| = 1; print "1..35125\n"; }
END {print "not ok 1\n" unless $loaded;}
use Carp;
# use blib;
use utf8;
use XML::Xerces;
use Config;
use lib 't';
use TestUtils qw(result is_object);
use vars qw($i $loaded);
use strict;
$loaded = 1;
$i = 1;
result($loaded);
######################### End of black magic.
# Insert your test code below (better if it prints "ok 13"
# (correspondingly "not ok 13") depending on the success of chunk 13
# of the test code):
# Create a couple of identical test documents
my $document = q[<?xml version="1.0" encoding="UTF-8"?>
<contributors>
<person Role="manager">
<name>Mike Pogue</name>
<email>[EMAIL PROTECTED]</email>
</person>
<person Role="developer">
<name>Tom Watson</name>
<email>[EMAIL PROTECTED]</email>
</person>
<person Role="tech writer">
<name>Susan Hardenbrook</name>
<email>[EMAIL PROTECTED]</email>
</person>
</contributors>];
my $DOM1 = new XML::Xerces::XercesDOMParser;
my $ERROR_HANDLER = XML::Xerces::PerlErrorHandler->new();
$DOM1->setErrorHandler($ERROR_HANDLER);
$DOM1->parse(XML::Xerces::MemBufInputSource->new($document));
my $DOM2 = new XML::Xerces::XercesDOMParser;
$DOM2->setErrorHandler($ERROR_HANDLER);
$DOM2->parse(XML::Xerces::MemBufInputSource->new($document, 'foo'));
my $doc1 = $DOM1->getDocument();
my $doc2 = $DOM2->getDocument();
my $root1 = $doc1->getDocumentElement();
my @persons1 = $doc1->getElementsByTagName('person');
my @names1 = $doc1->getElementsByTagName('name');
my $root2 = $doc2->getDocumentElement();
my @persons2 = $doc2->getElementsByTagName('person');
my @names2 = $doc1->getElementsByTagName('name');
# importing a child from a different document
eval {
my $copy = $doc1->importNode($persons1[0],0);
$root1->appendChild($copy);
};
result(!$@ &&
scalar @persons1 < scalar ($root1->getElementsByTagName('person'))
);
# check that creating an element with an illegal charater
eval {
my $el = $doc1->createElement('?');
};
result($@
&& $@->{code} == $XML::Xerces::DOMException::INVALID_CHARACTER_ERR
);
# check that an element can't start with a digit
eval {
my $el = $doc1->createElement('9');
};
result($@
&& $@->{code} == $XML::Xerces::DOMException::INVALID_CHARACTER_ERR
);
# check that getElementById() doesn't segfault on undef ID
eval {
$doc1->getElementById(undef);
};
result($@);
# check that an element can have a digit if a valid character comes first
eval {
$DOM1->parse('t/letter.xml');
};
if ($@) {
if (ref($@)) {
if ($@->isa('XML::Xerces::XMLException')) {
die "Couldn't open letter.xml: ", $@->getMessage();
} elsif ($@->isa('XML::Xerces::DOMException')) {
die "Couldn't open letter.xml: msg=<$@->{msg}>, code=$@->{code}";
}
}
}
$doc1 = $DOM1->getDocument();
my ($digit_node) = $doc1->getElementsByTagName('digit');
my @digits;
foreach my $range_node ($digit_node->getElementsByTagName('range')) {
my $low = hex($range_node->getAttribute('low'));
my $high = hex($range_node->getAttribute('high'));
push(@digits,$low..$high);
}
foreach my $single_node ($digit_node->getElementsByTagName('single')) {
my $value = hex($single_node->getAttribute('value'));
push(@digits,$value);
}
@digits = map {chr($_)} @digits;
foreach my $char (@digits) {
eval {
my $el = $doc1->createElement("_$char");
};
if ($@) {
if (ref $@) {
print STDERR "Error code: $@->{code}\n";
} else {
print STDERR $@;
}
}
result(!$@) || printf("char: <0x%.4X>\n",ord($char));
}
my ($extender_node) = $doc1->getElementsByTagName('extender');
my @extenders;
foreach my $range_node ($extender_node->getElementsByTagName('range')) {
my $low = hex($range_node->getAttribute('low'));
my $high = hex($range_node->getAttribute('high'));
push(@extenders,$low..$high);
}
foreach my $single_node ($extender_node->getElementsByTagName('single')) {
my $value = hex($single_node->getAttribute('value'));
push(@extenders,$value);
}
@extenders = map {chr($_)} @extenders;
foreach my $char (@extenders) {
eval {
my $el = $doc1->createElement("_$char");
};
if ($@) {
if (ref $@) {
print STDERR "Error code: $@->{code}\n";
} else {
print STDERR $@;
}
}
result(!$@) || printf("char: <0x%.4X>\n",ord($char));
}
my ($combining_char_node) = $doc1->getElementsByTagName('combiningchar');
my @combining_chars;
foreach my $range_node ($combining_char_node->getElementsByTagName('range')) {
my $low = hex($range_node->getAttribute('low'));
my $high = hex($range_node->getAttribute('high'));
push(@combining_chars,$low..$high);
}
foreach my $single_node ($combining_char_node->getElementsByTagName('single')) {
my $value = hex($single_node->getAttribute('value'));
push(@combining_chars,$value);
}
@combining_chars = map {chr($_)} @combining_chars;
foreach my $char (@combining_chars) {
eval {
my $el = $doc1->createElement("_$char");
};
if ($@) {
if (ref $@) {
print STDERR "Error code: $@->{code}\n";
} else {
print STDERR $@;
}
}
result(!$@) || printf("char: <0x%.4X>\n",ord($char));
}
my ($letter_node) = $doc1->getElementsByTagName('letter');
my @letters;
foreach my $range_node ($letter_node->getElementsByTagName('range')) {
my $low = hex($range_node->getAttribute('low'));
my $high = hex($range_node->getAttribute('high'));
push(@letters,$low..$high);
}
foreach my $single_node ($letter_node->getElementsByTagName('single')) {
my $value = hex($single_node->getAttribute('value'));
push(@letters,$value);
}
@letters = map {chr($_)} @letters;
# $XML::Xerces::DEBUG_UTF8_IN = 1;
# $XML::Xerces::DEBUG_UTF8_OUT = 1;
foreach my $char (@letters) {
eval {
my $el = $doc1->createElement("$char");
};
if ($@) {
if (ref $@) {
print STDERR "Error code: $@->{code}\n";
} else {
print STDERR $@;
}
}
result(!$@) || printf("char: <0x%.4X>\n",ord($char));
}
my ($ideograph_node) = $doc1->getElementsByTagName('ideographic');
my @ideographs;
foreach my $range_node ($ideograph_node->getElementsByTagName('range')) {
my $low = hex($range_node->getAttribute('low'));
my $high = hex($range_node->getAttribute('high'));
push(@ideographs,$low..$high);
}
foreach my $single_node ($ideograph_node->getElementsByTagName('single')) {
my $value = hex($single_node->getAttribute('value'));
push(@ideographs,$value);
}
@ideographs = map {chr($_)} @ideographs;
# $XML::Xerces::DEBUG_UTF8_IN = 1;
# $XML::Xerces::DEBUG_UTF8_OUT = 1;
foreach my $char (@ideographs) {
eval {
my $el = $doc1->createElement("$char");
};
if ($@) {
if (ref $@) {
print STDERR "Error code: $@->{code}\n";
} else {
print STDERR $@;
}
}
result(!$@) || printf("char: <0x%.4X>\n",ord($char));
}
$XML::Xerces::DEBUG_UTF8_IN = 0;
$XML::Xerces::DEBUG_UTF8_OUT = 0;
# check that an element can start with an underscore
eval {
my $el = $doc1->createElement('_');
};
result(!$@);
# check that an element can start with an colon
eval {
my $el = $doc1->createElement(':');
};
result(!$@);
1.1 xml-xerces/perl/t/DOMElement.t
Index: DOMElement.t
===================================================================
# Before `make install' is performed this script should be runnable
# with `make test'. After `make install' it should work as `perl
# DOMElement.t'
######################### We start with some black magic to print on failure.
# Change 1..1 below to 1..last_test_to_print .
# (It may become useful if the test is moved to ./t subdirectory.)
BEGIN { $| = 1; print "1..4\n"; }
END {print "not ok 1\n" unless $loaded;}
use Carp;
use XML::Xerces;
use lib 't';
use TestUtils qw(result $DOM $PERSONAL_FILE_NAME);
use vars qw($i $loaded);
use strict;
$loaded = 1;
$i = 1;
result($loaded);
######################### End of black magic.
# Insert your test code below (better if it prints "ok 13"
# (correspondingly "not ok 13") depending on the success of chunk 13
# of the test code):
$DOM->parse($PERSONAL_FILE_NAME);
my $doc = $DOM->getDocument();
my $doctype = $doc->getDoctype();
my @persons = $doc->getElementsByTagName('person');
my @names = $doc->getElementsByTagName('name');
# try to set an Attribute, 'foo', to undef
result(!$persons[0]->setAttribute('foo',undef));
# try to set an Attribute, undef, to 'foo'
result(!$persons[0]->setAttribute(undef,'foo'));
# ensure that actual_cast() is being called
result(ref $persons[0] eq 'XML::Xerces::DOMElement');
1.1 xml-xerces/perl/t/DOMEntity.t
Index: DOMEntity.t
===================================================================
# Before `make install' is performed this script should be runnable
# with `make test'. After `make install' it should work as `perl
# DOMEntity.t'
######################### We start with some black magic to print on failure.
# Change 1..1 below to 1..last_test_to_print .
# (It may become useful if the test is moved to ./t subdirectory.)
BEGIN { $| = 1; print "1..3\n"; }
END {print "not ok 1\n" unless $loaded;}
use Carp;
# use blib;
use XML::Xerces;
use lib 't';
use TestUtils qw(result $DOM);
use vars qw($i $loaded);
use strict;
$loaded = 1;
$i = 1;
result($loaded);
######################### End of black magic.
# Insert your test code below (better if it prints "ok 13"
# (correspondingly "not ok 13") depending on the success of chunk 13
# of the test code):
my $document = <<'EOT';
<?xml version="1.0" encoding="ISO-8859-1" standalone="yes"?>
<!DOCTYPE foo [
<!ENTITY data2 "DATA">
<!ENTITY data "DATA">
<!ENTITY bar "BAR">
<!ELEMENT foo ANY>
]>
<foo>This is a test &data; of entities</foo>
EOT
$DOM->setCreateEntityReferenceNodes(1);
$DOM->setValidationScheme($XML::Xerces::AbstractDOMParser::Val_Never);
my $is = eval{XML::Xerces::MemBufInputSource->new($document)};
XML::Xerces::error($@) if $@;
eval{$DOM->parse($is)};
XML::Xerces::error($@) if $@;
my $doc = $DOM->getDocument();
my $doctype = $doc->getDoctype();
# get the single <element> node
my %ents = $doctype->getEntities();
my $fail;
result(exists $ents{data} && $ents{data} eq 'DATA', $fail=1);
result(exists $ents{bar} && $ents{bar} eq 'BAR', $fail=1);
1.6 +35 -31 xml-xerces/perl/t/DOMException.t
1.1 xml-xerces/perl/t/DOMNamedNodeMap.t
Index: DOMNamedNodeMap.t
===================================================================
# Before `make install' is performed this script should be runnable
# with `make test'. After `make install' it should work as `perl
# DOMNamedNodeMap.t'
######################### We start with some black magic to print on failure.
# Change 1..1 below to 1..last_test_to_print .
# (It may become useful if the test is moved to ./t subdirectory.)
BEGIN { $| = 1; print "1..15\n"; }
END {print "not ok 1\n" unless $loaded;}
use Carp;
use XML::Xerces;
use lib 't';
use TestUtils qw(result is_object $DOM);
use vars qw($i $loaded);
use strict;
$loaded = 1;
$i = 1;
result($loaded);
######################### End of black magic.
# Insert your test code below (better if it prints "ok 13"
# (correspondingly "not ok 13") depending on the success of chunk 13
# of the test code):
my $document = <<EOT;
<list>
<element one='1' two='2' three='3'/>
<none>text</none>
</list>
EOT
$DOM->parse(XML::Xerces::MemBufInputSource->new($document));
my $doc = $DOM->getDocument();
# this tests a bug that getAttributes() should return an empty list
# when there are no attributes (even when bogusly called on a text node)
my ($element) = $doc->getElementsByTagName('none');
my @attrs = $element->getFirstChild->getAttributes();
result(scalar @attrs != 1);
# get the single <element> node
($element) = $doc->getElementsByTagName('element');
my %attrs = $element->getAttributes();
result(scalar keys %attrs == 3 &&
$attrs{one} == 1 &&
$attrs{two} == 2 &&
$attrs{three} == 3);
# test that we can still get a DOMNodeList object
# and test getLength()
my $dom_node_map = $element->getAttributes();
result(is_object($dom_node_map)
&& $dom_node_map->isa('XML::Xerces::DOMNamedNodeMap')
&& $dom_node_map->getLength() == scalar keys %attrs
);
# test item()
for (my $i=0;$i<scalar keys %attrs ;$i++) {
my $node = $dom_node_map->item($i);
result($attrs{$node->getNodeName} == $node->getNodeValue);
}
# test getNamedItem()
foreach (keys %attrs) {
result($dom_node_map->getNamedItem($_)->getNodeValue eq $attrs{$_});
}
# test setNamedItem()
my $four = $doc->createAttribute('four');
$four->setNodeValue('4');
$dom_node_map->setNamedItem($four);
result($dom_node_map->getNamedItem('four')->getNodeValue eq $four->getNodeValue);
# test removeNamedItem()
$dom_node_map->removeNamedItem('four');
result($dom_node_map->getLength() == scalar keys %attrs);
#
# Test the DOM Level 2 methods
#
my $uri = 'http://www.foo.bar/';
$document = <<EOT;
<list xmlns:qs="$uri">
<element qs:one='1' qs:two='2' qs:three='3' one='27'/>
</list>
EOT
$DOM->setDoNamespaces(1);
$DOM->parse(XML::Xerces::MemBufInputSource->new($document));
$doc = $DOM->getDocument();
# get the single <element> node
($element) = $doc->getElementsByTagName('element');
%attrs = $element->getAttributes();
$dom_node_map = $element->getAttributes();
# test getNamedItemNS()
my $oneNS = $dom_node_map->getNamedItemNS($uri,'one');
my $one = $dom_node_map->getNamedItem('one');
result($one->getNodeValue eq '27'
&& $oneNS->getNodeValue eq '1'
);
# test setNamedItem()
$four = $doc->createAttributeNS($uri,'four');
$four->setNodeValue('4');
$dom_node_map->setNamedItemNS($four);
result($dom_node_map->getNamedItemNS($uri,'four')->getNodeValue eq
$four->getNodeValue);
# test removeNamedItem()
$dom_node_map->removeNamedItemNS($uri,'four');
result($dom_node_map->getLength() == scalar keys %attrs);
1.1 xml-xerces/perl/t/DOMNode.t
Index: DOMNode.t
===================================================================
# Before `make install' is performed this script should be runnable
# with `make test'. After `make install' it should work as `perl
# DOMNode.t'
######################### We start with some black magic to print on failure.
# Change 1..1 below to 1..last_test_to_print .
# (It may become useful if the test is moved to ./t subdirectory.)
BEGIN { $| = 1; print "1..4\n"; }
END {print "not ok 1\n" unless $loaded;}
use Carp;
use blib;
use XML::Xerces;
use Config;
use lib 't';
use TestUtils qw(result is_object);
use vars qw($i $loaded);
use strict;
$loaded = 1;
$i = 1;
result($loaded);
######################### End of black magic.
# Insert your test code below (better if it prints "ok 13"
# (correspondingly "not ok 13") depending on the success of chunk 13
# of the test code):
# Create a couple of identical test documents
my $document = q[<?xml version="1.0" encoding="UTF-8"?>
<contributors>
<person Role="manager">
<name>Mike Pogue</name>
<email>[EMAIL PROTECTED]</email>
</person>
<person Role="developer">
<name>Tom Watson</name>
<email>[EMAIL PROTECTED]</email>
</person>
<person Role="tech writer">
<name>Susan Hardenbrook</name>
<email>[EMAIL PROTECTED]</email>
</person>
</contributors>];
my $DOM1 = new XML::Xerces::XercesDOMParser;
my $ERROR_HANDLER = XML::Xerces::PerlErrorHandler->new();
$DOM1->setErrorHandler($ERROR_HANDLER);
my $is = eval{XML::Xerces::MemBufInputSource->new($document)};
XML::Xerces::error($@) if $@;
eval {$DOM1->parse($is)};
XML::Xerces::error($@) if $@;
my $DOM2 = new XML::Xerces::XercesDOMParser;
$DOM2->setErrorHandler($ERROR_HANDLER);
eval {$DOM2->parse(XML::Xerces::MemBufInputSource->new($document, 'foo'))};
XML::Xerces::error($@) if $@;
my $doc1 = $DOM1->getDocument();
my $doc2 = $DOM2->getDocument();
my $root1 = $doc1->getDocumentElement();
my @persons1 = $doc1->getElementsByTagName('person');
my @names1 = $doc1->getElementsByTagName('name');
my $root2 = $doc2->getDocumentElement();
my @persons2 = $doc2->getElementsByTagName('person');
my @names2 = $doc1->getElementsByTagName('name');
# importing a child from a different document
eval {
my $copy = $doc1->importNode($persons1[0],0);
$root1->appendChild($copy);
};
result(!$@ &&
scalar @persons1 < scalar ($root1->getElementsByTagName('person')));
# test the equality operators
my @people = $doc1->getElementsByTagName('person');
result($root1 != $root2);
result($people[0] == $persons1[0]);
1.1 xml-xerces/perl/t/DOMNodeIterator.t
Index: DOMNodeIterator.t
===================================================================
# Before `make install' is performed this script should be runnable
# with `make test'. After `make install' it should work as `perl
# DOMNodeIterator.t'
######################### We start with some black magic to print on failure.
# Change 1..1 below to 1..last_test_to_print .
# (It may become useful if the test is moved to ./t subdirectory.)
BEGIN { $| = 1; print "1..5\n"; }
END {print "not ok 1\n" unless $loaded;}
use Carp;
# use blib;
use XML::Xerces;
use Config;
use lib 't';
use TestUtils qw(result is_object);
use vars qw($i $loaded);
use strict;
$loaded = 1;
$i = 1;
result($loaded);
package MyNodeFilter;
use strict;
use vars qw(@ISA);
@ISA = qw(XML::Xerces::PerlNodeFilter);
sub acceptNode {
my ($self,$node) = @_;
return $XML::Xerces::DOMNodeFilter::FILTER_ACCEPT;
}
package main;
######################### End of black magic.
# Insert your test code below (better if it prints "ok 13"
# (correspondingly "not ok 13") depending on the success of chunk 13
# of the test code):
# Create a couple of identical test documents
my $document = q[<?xml version="1.0" encoding="UTF-8"?>
<contributors>
<person Role="manager">
<name>Mike Pogue</name>
<email>[EMAIL PROTECTED]</email>
</person>
<person Role="developer">
<name>Tom Watson</name>
<email>[EMAIL PROTECTED]</email>
</person>
<person Role="tech writer">
<name>Susan Hardenbrook</name>
<email>[EMAIL PROTECTED]</email>
</person>
</contributors>];
my $DOM = new XML::Xerces::XercesDOMParser;
my $ERROR_HANDLER = XML::Xerces::PerlErrorHandler->new();
$DOM->setErrorHandler($ERROR_HANDLER);
$DOM->parse(XML::Xerces::MemBufInputSource->new($document));
my $doc = $DOM->getDocument();
my $root = $doc->getDocumentElement();
my $filter = MyNodeFilter->new();
my $what = $XML::Xerces::DOMNodeFilter::SHOW_ELEMENT;
my $iterator = $doc->createNodeIterator($root,$what,$filter,1);
result(defined $iterator
and is_object($iterator)
and $iterator->isa('XML::Xerces::DOMNodeIterator'));
# test that nextNode() returns the first node in the set
result($iterator->nextNode() == $root);
my $success = 1;
my $count = 0;
while (my $node = $iterator->nextNode()) {
$count++;
$success = 0 unless $node->isa('XML::Xerces::DOMElement');
}
# test that we only got elements
result($success);
#test that we got all the elements
result($count == 9);
1.1 xml-xerces/perl/t/DOMNodeList.t
Index: DOMNodeList.t
===================================================================
# Before `make install' is performed this script should be runnable with
# `make test'. After `make install' it should work as `perl DOMNodeList.t'
######################### We start with some black magic to print on failure.
# Change 1..1 below to 1..last_test_to_print .
# (It may become useful if the test is moved to ./t subdirectory.)
BEGIN { $| = 1; print "1..10\n"; }
END {print "not ok 1\n" unless $loaded;}
use Carp;
use Cwd;
# use blib;
use XML::Xerces;
use lib 't';
use TestUtils qw(result $DOM $PERSONAL_FILE_NAME is_object);
use vars qw($i $loaded);
use strict;
$loaded = 1;
$i = 1;
result($loaded);
######################### End of black magic.
# Insert your test code below (better if it prints "ok 13"
# (correspondingly "not ok 13") depending on the success of chunk 13
# of the test code):
$DOM->parse( new XML::Xerces::LocalFileInputSource($PERSONAL_FILE_NAME) );
my $doc = $DOM->getDocument();
# test automatic conversion to perl list
my @node_list = $doc->getElementsByTagName('person');
result(scalar @node_list == 6);
# test that we can still get a DOMNodeList object
my $dom_node_list = $doc->getElementsByTagName('person');
result(is_object($dom_node_list) &&
$dom_node_list->isa('XML::Xerces::DOMNodeList'));
result($dom_node_list->getLength() == scalar @node_list);
for (my $i=0;$i<scalar @node_list;$i++) {
result($node_list[$i] == $dom_node_list->item($i));
}
1.1 xml-xerces/perl/t/DOMTreeWalker.t
Index: DOMTreeWalker.t
===================================================================
# Before `make install' is performed this script should be runnable
# with `make test'. After `make install' it should work as `perl
# DOMNode.t'
######################### We start with some black magic to print on failure.
# Change 1..1 below to 1..last_test_to_print .
# (It may become useful if the test is moved to ./t subdirectory.)
BEGIN { $| = 1; print "1..5\n"; }
END {print "not ok 1\n" unless $loaded;}
use Carp;
use blib;
use XML::Xerces;
use Config;
use lib 't';
use TestUtils qw(result is_object);
use vars qw($i $loaded);
use strict;
$loaded = 1;
$i = 1;
result($loaded);
package MyNodeFilter;
use strict;
use vars qw(@ISA);
@ISA = qw(XML::Xerces::PerlNodeFilter);
sub acceptNode {
my ($self,$node) = @_;
return $XML::Xerces::DOMNodeFilter::FILTER_ACCEPT;
}
package main;
######################### End of black magic.
# Insert your test code below (better if it prints "ok 13"
# (correspondingly "not ok 13") depending on the success of chunk 13
# of the test code):
# Create a couple of identical test documents
my $document = q[<?xml version="1.0" encoding="UTF-8"?>
<contributors>
<person Role="manager">
<name>Mike Pogue</name>
<email>[EMAIL PROTECTED]</email>
</person>
<person Role="developer">
<name>Tom Watson</name>
<email>[EMAIL PROTECTED]</email>
</person>
<person Role="tech writer">
<name>Susan Hardenbrook</name>
<email>[EMAIL PROTECTED]</email>
</person>
</contributors>];
my $DOM = new XML::Xerces::XercesDOMParser;
my $ERROR_HANDLER = XML::Xerces::PerlErrorHandler->new();
$DOM->setErrorHandler($ERROR_HANDLER);
$DOM->parse(XML::Xerces::MemBufInputSource->new($document));
my $doc = $DOM->getDocument();
my $root = $doc->getDocumentElement();
my $filter = MyNodeFilter->new();
my $what = $XML::Xerces::DOMNodeFilter::SHOW_ELEMENT;
my $walker = $doc->createTreeWalker($root,$what,$filter,1);
result(defined $walker
and is_object($walker)
and $walker->isa('XML::Xerces::DOMTreeWalker'));
# test parentNode
$walker->nextNode();
result($walker->parentNode() == $root);
my $success = 1;
my $count = 0;
while (my $node = $walker->nextNode()) {
$count++;
$success = 0 unless $node->isa('XML::Xerces::DOMElement');
}
# test that we only got elements
result($success);
#test that we got all the elements
result($count == 9);
1.1 xml-xerces/perl/t/DOMWriter.t
Index: DOMWriter.t
===================================================================
# Before `make install' is performed this script should be runnable
# with `make test'. After `make install' it should work as `perl
# DOMWriter.t'
######################### We start with some black magic to print on failure.
# Change 1..1 below to 1..last_test_to_print .
# (It may become useful if the test is moved to ./t subdirectory.)
BEGIN { $| = 1; print "1..5\n"; }
END {print "not ok 1\n" unless $loaded;}
use Carp;
use blib;
use XML::Xerces;
use Config;
use lib 't';
use TestUtils qw(result is_object);
use vars qw($i $loaded);
use strict;
$loaded = 1;
$i = 1;
result($loaded);
######################### End of black magic.
# Insert your test code below (better if it prints "ok 13"
# (correspondingly "not ok 13") depending on the success of chunk 13
# of the test code):
# Create a couple of identical test documents
my $document = q[<?xml version="1.0" encoding="UTF-8"?>
<contributors>
<person Role="manager">
<name>Mike Pogue</name>
<email>[EMAIL PROTECTED]</email>
</person>
<person Role="developer">
<name>Tom Watson</name>
<email>[EMAIL PROTECTED]</email>
</person>
<person Role="tech writer">
<name>Susan Hardenbrook</name>
<email>[EMAIL PROTECTED]</email>
</person>
</contributors>];
my $dom = XML::Xerces::XercesDOMParser->new();
my $impl = XML::Xerces::DOMImplementationRegistry::getDOMImplementation('LS');
my $writer = $impl->createDOMWriter();
# $writer->setNewLine(0);
# $writer->setEncoding(0);
my $handler = XML::Xerces::PerlErrorHandler->new();
$dom->setErrorHandler($handler);
eval{$dom->parse(XML::Xerces::MemBufInputSource->new($document))};
XML::Xerces::error($@) if $@;
my $target = XML::Xerces::MemBufFormatTarget->new();
my $doc = $dom->getDocument();
$writer->writeNode($target,$doc);
my $output = $target->getString();
result($output);
print STDERR "$output\n";
---------------------------------------------------------------------
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
