XML-PugiXML

 view release on metacpan or  search on metacpan

t/01-basic.t  view on Meta::CPAN

    is($node->text, 'deep', 'can navigate deep nesting');
}

# Test long attribute value
{
    my $long_val = 'x' x 10000;
    my $doc = XML::PugiXML->new;
    $doc->load_string("<root attr=\"$long_val\"/>");
    is(length($doc->root->attr('attr')->value), 10000, 'long attr value preserved');
}

# Test many children
{
    my $xml = '<root>' . ('<item/>' x 1000) . '</root>';
    my $doc = XML::PugiXML->new;
    ok($doc->load_string($xml), 'many children parse');
    my @children = $doc->root->children;
    is(scalar @children, 1000, 'got all 1000 children');
}

# Test XPath returning empty
{
    my $doc = XML::PugiXML->new;
    $doc->load_string('<root><item/></root>');
    my $node = $doc->select_node('//nonexistent');
    ok(!defined $node || !$node->valid, 'xpath no match returns undef or invalid');
    my @nodes = $doc->select_nodes('//nonexistent');
    is(scalar @nodes, 0, 'xpath no matches returns empty list');
}

# Test node modification after XPath
{
    my $doc = XML::PugiXML->new;
    $doc->load_string('<root><a/><b/><c/></root>');
    my @nodes = $doc->select_nodes('//a | //b | //c');
    is(scalar @nodes, 3, 'xpath union works');
    $nodes[0]->set_text('modified');
    is($nodes[0]->text, 'modified', 'can modify xpath result');
}

# Test whitespace handling
{
    my $doc = XML::PugiXML->new;
    $doc->load_string('<root>  text with spaces  </root>');
    is($doc->root->text, '  text with spaces  ', 'whitespace preserved in text');
}

# Test special characters in names
{
    my $doc = XML::PugiXML->new;
    $doc->load_string('<root xmlns:ns="http://example.com"><ns:item ns:attr="val"/></root>');
    my $item = $doc->root->first_child;
    is($item->name, 'ns:item', 'namespaced element name');
    is($item->attr('ns:attr')->value, 'val', 'namespaced attr value');
}

#--------------------------------------------------
# CDATA and Comment tests
#--------------------------------------------------

# Test append_cdata
{
    my $doc = XML::PugiXML->new;
    $doc->load_string('<root/>');
    my $cdata = $doc->root->append_cdata('<script>alert(1)</script>');
    ok($cdata, 'append_cdata returns node');
    is($cdata->type, 4, 'CDATA node type is 4');
    like($doc->to_string, qr/<!\[CDATA\[<script>alert\(1\)<\/script>\]\]>/, 'CDATA in output');
}

# Test append_comment
{
    my $doc = XML::PugiXML->new;
    $doc->load_string('<root/>');
    my $comment = $doc->root->append_comment('This is a comment');
    ok($comment, 'append_comment returns node');
    is($comment->type, 5, 'comment node type is 5');
    like($doc->to_string, qr/<!--This is a comment-->/, 'comment in output');
}

# Test node type
{
    my $doc = XML::PugiXML->new;
    $doc->load_string('<root>text</root>');
    is($doc->root->type, 2, 'element node type is 2');

    # Text node (PCDATA)
    my $text = $doc->root->first_child;
    is($text->type, 3, 'text node type is 3');
}

# Test reading existing CDATA
{
    my $doc = XML::PugiXML->new;
    $doc->load_string('<root><![CDATA[<raw>&data</raw>]]></root>');
    is($doc->root->text, '<raw>&data</raw>', 'CDATA content read correctly');
    my $cdata_node = $doc->root->first_child;
    is($cdata_node->type, 4, 'existing CDATA node type is 4');
}

#--------------------------------------------------
# New functionality tests
#--------------------------------------------------

# Test prepend_child
{
    my $doc = XML::PugiXML->new;
    $doc->load_string('<root><b/><c/></root>');
    my $a = $doc->root->prepend_child('a');
    ok($a, 'prepend_child returns node');
    is($doc->root->first_child->name, 'a', 'prepend_child inserts at beginning');
}

# Test insert_child_before
{
    my $doc = XML::PugiXML->new;
    $doc->load_string('<root><a/><c/></root>');
    my $c = $doc->root->child('c');
    my $b = $doc->root->insert_child_before('b', $c);
    ok($b, 'insert_child_before returns node');
    my @children = grep { $_->type == 2 } $doc->root->children;
    is($children[1]->name, 'b', 'insert_child_before at correct position');
}

# Test insert_child_after
{
    my $doc = XML::PugiXML->new;
    $doc->load_string('<root><a/><c/></root>');
    my $a = $doc->root->child('a');
    my $b = $doc->root->insert_child_after('b', $a);
    ok($b, 'insert_child_after returns node');
    my @children = grep { $_->type == 2 } $doc->root->children;
    is($children[1]->name, 'b', 'insert_child_after at correct position');
}

# Test prepend_attr
{
    my $doc = XML::PugiXML->new;
    $doc->load_string('<root b="2" c="3"/>');
    my $a = $doc->root->prepend_attr('a');
    $a->set_value('1');
    my @attrs = $doc->root->attrs;
    is($attrs[0]->name, 'a', 'prepend_attr inserts at beginning');
}

# Test path()
{
    my $doc = XML::PugiXML->new;
    $doc->load_string('<root><parent><child id="1"/></parent></root>');
    my $child = $doc->root->child('parent')->child('child');
    is($child->path, '/root/parent/child', 'path returns correct XPath');
    is($child->path('.'), '.root.parent.child', 'path with custom delimiter');
}

# Test find_child_by_attribute
{
    my $doc = XML::PugiXML->new;
    $doc->load_string('<root><item id="1"/><item id="2"/><item id="3"/></root>');

t/01-basic.t  view on Meta::CPAN

# Test PARSE_ESCAPES (enabled by default, test explicit use)
{
    my $doc = XML::PugiXML->new;
    $doc->load_string('<root>&#65;&#66;&#67;</root>', XML::PugiXML::PARSE_ESCAPES());
    is($doc->root->text, 'ABC', 'PARSE_ESCAPES decodes numeric entities');
}

# Test PARSE_EOL (normalizes line endings)
{
    my $doc = XML::PugiXML->new;
    $doc->load_string("<root>line1\r\nline2</root>", XML::PugiXML::PARSE_EOL());
    my $text = $doc->root->text;
    unlike($text, qr/\r/, 'PARSE_EOL normalizes CRLF to LF');
}

#--------------------------------------------------
# Test gaps: error paths and edge cases
#--------------------------------------------------

# doc->child with nonexistent name
{
    my $doc = XML::PugiXML->new;
    $doc->load_string('<root/>');
    ok(!defined $doc->child('nonexistent'), 'doc->child nonexistent returns undef');
}

# load_file failure sets $@
{
    my $doc = XML::PugiXML->new;
    $doc->load_file('/nonexistent/path.xml');
    like($@, qr/parse error/i, 'load_file failure sets $@ with error');
}

# load_string $@ includes offset
{
    my $doc = XML::PugiXML->new;
    $doc->load_string('<root><bad');
    like($@, qr/offset \d+/, 'parse error $@ includes offset');
}

# set_value on element node returns false
{
    my $doc = XML::PugiXML->new;
    $doc->load_string('<root/>');
    ok(!$doc->root->set_value('x'), 'set_value on element returns false');
}

# set_name on text node returns false
{
    my $doc = XML::PugiXML->new;
    $doc->load_string('<root>text</root>');
    my $text_node = $doc->root->first_child;
    is($text_node->type, 3, 'got text node');
    ok(!$text_node->set_name('x'), 'set_name on text node returns false');
}

# value() on CDATA node
{
    my $doc = XML::PugiXML->new;
    $doc->load_string('<root><![CDATA[data]]></root>');
    my $cdata = $doc->root->first_child;
    is($cdata->value, 'data', 'value() on CDATA node returns content');
}

# previous_sibling with name filter no match
{
    my $doc = XML::PugiXML->new;
    $doc->load_string('<root><a/><b/><c/></root>');
    my $c = $doc->root->last_child;
    ok(!defined $c->previous_sibling('z'), 'previous_sibling(name) no match returns undef');
}

# children with name that matches nothing
{
    my $doc = XML::PugiXML->new;
    $doc->load_string('<root><a/><b/></root>');
    my @none = $doc->root->children('z');
    is(scalar @none, 0, 'children(nonexistent) returns empty list');
}

# attrs on node with no attributes
{
    my $doc = XML::PugiXML->new;
    $doc->load_string('<root/>');
    my @a = $doc->root->attrs;
    is(scalar @a, 0, 'attrs on no-attribute node returns empty list');
}

# Node::select_nodes with invalid XPath
{
    my $doc = XML::PugiXML->new;
    $doc->load_string('<root/>');
    eval { $doc->root->select_nodes('///bad'); };
    ok($@, 'invalid xpath on node select_nodes throws');
}

# evaluate_node with no match
{
    my $doc = XML::PugiXML->new;
    $doc->load_string('<root><a/></root>');
    my $xpath = $doc->compile_xpath('//nonexistent');
    my $result = $xpath->evaluate_node($doc->root);
    ok(!defined $result, 'evaluate_node no match returns undef');
}

# evaluate_nodes with no match
{
    my $doc = XML::PugiXML->new;
    $doc->load_string('<root><a/></root>');
    my $xpath = $doc->compile_xpath('//nonexistent');
    my @results = $xpath->evaluate_nodes($doc->root);
    is(scalar @results, 0, 'evaluate_nodes no match returns empty list');
}

# PARSE_COMMENTS functional test
{
    my $doc = XML::PugiXML->new;
    $doc->load_string('<root><!--hello--></root>', XML::PugiXML::PARSE_COMMENTS());
    my @comments = grep { $_->type == 5 } $doc->root->children;
    is(scalar @comments, 1, 'PARSE_COMMENTS makes comments accessible');
    is($comments[0]->value, 'hello', 'PARSE_COMMENTS comment content');
}

# PARSE_CDATA functional test
{
    my $doc = XML::PugiXML->new;
    $doc->load_string('<root><![CDATA[raw]]></root>', XML::PugiXML::PARSE_CDATA());
    my @cdata = grep { $_->type == 4 } $doc->root->children;
    is(scalar @cdata, 1, 'PARSE_CDATA makes CDATA nodes accessible');
    is($cdata[0]->value, 'raw', 'PARSE_CDATA content');
}

# save_file clears $@ on success
{
    my ($fh, $tmp) = tempfile(SUFFIX => '.xml', UNLINK => 1);
    close $fh;
    my $doc = XML::PugiXML->new;
    $doc->load_string('<bad>');  # sets $@
    ok($@, '$@ set before save_file');
    $doc->load_string('<root/>');
    $doc->save_file($tmp);
    is($@, '', 'save_file clears $@ on success');
    unlink $tmp;
}

#--------------------------------------------------
# Stale handle detection (generation counter)
#--------------------------------------------------

# Test stale node after reset()
{
    my $doc = XML::PugiXML->new;
    $doc->load_string('<root><item>hello</item></root>');
    my $node = $doc->root->child('item');
    is($node->text, 'hello', 'node works before reset');

    $doc->reset;

    eval { $node->text; };
    like($@, qr/Stale node handle/, 'accessing node after reset() croaks');

    eval { $node->name; };
    like($@, qr/Stale node handle/, 'accessing name after reset() croaks');

    ok(!$node->valid, 'stale node valid() returns false');
}

# Test stale attr after reset()
{
    my $doc = XML::PugiXML->new;
    $doc->load_string('<root id="1"/>');
    my $attr = $doc->root->attr('id');
    is($attr->value, '1', 'attr works before reset');

    $doc->reset;

    eval { $attr->value; };
    like($@, qr/Stale attribute handle/, 'accessing attr after reset() croaks');

    ok(!$attr->valid, 'stale attr valid() returns false');
}

# Test stale node after load_string()
{
    my $doc = XML::PugiXML->new;
    $doc->load_string('<root><old/></root>');
    my $old_node = $doc->root;

    $doc->load_string('<newroot/>');

t/01-basic.t  view on Meta::CPAN

    my $attr = $doc->select_node('//@x');
    isa_ok($attr, 'XML::PugiXML::Attr', 'XPath returns Attr');
    my $elem = $attr->element;
    is($elem->name, 'a', 'element() from XPath attr returns correct parent');
}

# element() from attrs() list
{
    my $doc = XML::PugiXML->new;
    $doc->load_string('<root foo="1" bar="2"/>');
    my @attrs = $doc->root->attrs;
    is($attrs[0]->element->name, 'root', 'element() from attrs() list');
}

# element() from set_attr
{
    my $doc = XML::PugiXML->new;
    $doc->load_string('<root/>');
    my $attr = $doc->root->set_attr('key', 'val');
    is($attr->element->name, 'root', 'element() from set_attr');
}

# Test UTF-8 flagged input works normally
{
    my $doc = XML::PugiXML->new;
    my $utf8_xml = "<root>café</root>";
    utf8::upgrade($utf8_xml);
    ok(utf8::is_utf8($utf8_xml), 'test string is UTF-8 flagged');

    ok($doc->load_string($utf8_xml), 'load_string accepts UTF-8 flagged string');
    like($doc->root->text, qr/caf/, 'UTF-8 text preserved');
}

# Test set_text with non-ASCII
{
    my $doc = XML::PugiXML->new;
    $doc->load_string('<root/>');
    my $text = "Ünïcödé";
    utf8::upgrade($text);
    $doc->root->set_text($text);
    like($doc->root->text, qr/n.c/, 'set_text with UTF-8 works');
}

#--------------------------------------------------
# NODE_* type constants
#--------------------------------------------------
{
    is(XML::PugiXML::NODE_NULL(),        0, 'NODE_NULL');
    is(XML::PugiXML::NODE_DOCUMENT(),    1, 'NODE_DOCUMENT');
    is(XML::PugiXML::NODE_ELEMENT(),     2, 'NODE_ELEMENT');
    is(XML::PugiXML::NODE_PCDATA(),      3, 'NODE_PCDATA');
    is(XML::PugiXML::NODE_CDATA(),       4, 'NODE_CDATA');
    is(XML::PugiXML::NODE_COMMENT(),     5, 'NODE_COMMENT');
    is(XML::PugiXML::NODE_PI(),          6, 'NODE_PI');
    is(XML::PugiXML::NODE_DECLARATION(), 7, 'NODE_DECLARATION');
    is(XML::PugiXML::NODE_DOCTYPE(),     8, 'NODE_DOCTYPE');

    my $doc = XML::PugiXML->new;
    $doc->load_string('<root>text</root>');
    is($doc->root->type, XML::PugiXML::NODE_ELEMENT(), 'element type matches constant');
    is($doc->root->first_child->type, XML::PugiXML::NODE_PCDATA(), 'pcdata type matches constant');
}

#--------------------------------------------------
# New format/parse constants
#--------------------------------------------------
{
    ok(defined XML::PugiXML::FORMAT_INDENT_ATTRIBUTES(), 'FORMAT_INDENT_ATTRIBUTES defined');
    ok(defined XML::PugiXML::PARSE_WS_PCDATA_SINGLE(),   'PARSE_WS_PCDATA_SINGLE defined');

    my $doc = XML::PugiXML->new;
    $doc->load_string('<root a="1" b="2"/>');
    my $out = $doc->to_string("  ", XML::PugiXML::FORMAT_INDENT()
                                  | XML::PugiXML::FORMAT_INDENT_ATTRIBUTES());
    like($out, qr/\n.*a="1"/, 'FORMAT_INDENT_ATTRIBUTES wraps attrs');
}

#--------------------------------------------------
# Attr::set_name
#--------------------------------------------------
{
    my $doc = XML::PugiXML->new;
    $doc->load_string('<root old="v"/>');
    my $attr = $doc->root->attr('old');
    ok($attr->set_name('renamed'), 'set_name returns true');
    is($attr->name, 'renamed', 'attr name updated');
    is($doc->root->attr('renamed')->value, 'v', 'value preserved after rename');
    ok(!defined $doc->root->attr('old'), 'old name no longer present');
}

#--------------------------------------------------
# Stale-handle checks on secondary node arguments
#--------------------------------------------------
{
    my $doc = XML::PugiXML->new;
    $doc->load_string('<root><a/><b/></root>');
    my $a = $doc->root->child('a');
    my $b = $doc->root->child('b');
    $doc->reset;
    $doc->load_string('<root><x/></root>');
    my $root = $doc->root;

    eval { $root->insert_child_before('y', $a); };
    like($@, qr/Stale/, 'insert_child_before croaks on stale ref');

    eval { $root->insert_child_after('y', $a); };
    like($@, qr/Stale/, 'insert_child_after croaks on stale ref');

    eval { $root->remove_child($a); };
    like($@, qr/Stale/, 'remove_child croaks on stale arg');

    eval { $root->append_copy($a); };
    like($@, qr/Stale/, 'append_copy croaks on stale source');

    eval { $root->prepend_copy($a); };
    like($@, qr/Stale/, 'prepend_copy croaks on stale source');

    eval { $root->insert_copy_before($a, $b); };
    like($@, qr/Stale/, 'insert_copy_before croaks on stale arg');

    eval { $root->insert_copy_after($a, $b); };