use strict; use warnings; # Should be 38. use Test::More tests => 38; use XML::LibXSLT; { my $parser = XML::LibXML->new(); my $xslt = XML::LibXSLT->new(); # TEST ok($parser, '$parser was initted'); # TEST ok($xslt, '$xslt was initted'); $xslt->register_function('urn:foo' => 'test', sub { # TEST*4 ok(1, 'urn:foo was reached.'); return $_[1] ? ($_[0] . $_[1]) : $_[0]; } ); $xslt->register_function('urn:foo' => 'test2', sub { # TEST*2 is(ref($_[0]), 'XML::LibXML::NodeList', 'First argument is a NodeList'); ref($_[0]) } ); $xslt->register_function('urn:foo' => 'test3', sub { # TEST*2 is(scalar(@_), 0, 'No arguments were received.'); return; } ); my $source = $parser->parse_string(<<'EOT'); EOT my $style = $parser->parse_string(<<'EOT'); (( )) (( )) [[ ]] [[ ]] (( )) (( )) EOT # TEST ok($style, '$style is true'); my $stylesheet = $xslt->parse_stylesheet($style); my $results = $stylesheet->transform($source); # TEST ok($results, '$results is true.'); # TEST like ($stylesheet->output_string($results), qr(Foo!), 'Matches Foo!'); # TEST like ($stylesheet->output_string($results), qr(NodeList), 'Matches NodeList'); $xslt->register_function('urn:foo' => 'get_list', \&get_nodelist ); our @words = qw( one two three ); sub get_nodelist { my $nl = XML::LibXML::NodeList->new(); $nl -> push( map { XML::LibXML::Text->new($_) } @words ); return $nl; } $style = $parser->parse_string(<<'EOT');
  • EOT # TEST ok($style, '$style is true - 2'); $stylesheet = $xslt->parse_stylesheet($style); # TEST:$n=5; for my $n (1..5) { $results = $stylesheet->transform($source); # TEST*$n ok($results, '$results is true - 2 (' . $n . ')'); # TEST*$n like($stylesheet->output_string($results), qr(
  • one
  • ), 'Matches li-one - ' . $n ); # TEST*$n like ( $stylesheet->output_string($results), qr(
  • one
  • two
  • three
  • ), 'Output matches multiple lis - ' . $n ); } } { # testcase by Elizabeth Mattijsen my $parser = XML::LibXML->new; my $xsltproc = XML::LibXSLT->new; my $xml = $parser->parse_string( <<'XML' ); XML my $xslt = $parser->parse_string( <<'XSLT' ); XSLT my $aux = <<'XML'; 1st 2nd XML { XML::LibXSLT->register_function( ('http://foo', 'custom') => sub { $parser->parse_string( $aux )->findnodes('//y') } ); my $stylesheet = $xsltproc->parse_stylesheet($xslt); my $result = $stylesheet->transform($xml); # the behavior has changed in some version of libxslt my $expect = qq(1st2nd\n); # TEST like ($result->serialize, qr{(\Q\n\E)?\Q$expect\E}, 'Results serialize matches text.' ); } { XML::LibXSLT->register_function( ('http://foo', 'custom') => sub { $parser->parse_string( $aux )->findnodes('//y')->[0]; }); my $stylesheet = $xsltproc->parse_stylesheet($xslt); my $result = $stylesheet->transform($xml); my $expect = qq(1st\n); # TEST like ( $result->serialize, qr{(\Q\n\E)?\Q$expect\E}, 'Results serialize matches text - 2.' ); } } { my $parser = XML::LibXML->new; my $xsltproc = XML::LibXSLT->new; my $xslt = $parser->parse_string( <<'XSLT' ); XSLT $xsltproc->register_function( ("http://x/x", 'test') => sub { $_[0][0]->findnodes('//b[parent::a]') } ); my $stylesheet = $xsltproc->parse_stylesheet($xslt); my $result = $stylesheet->transform($parser->parse_string( <<'XML' )); XML # TEST is ($result->serialize, qq(\n\n), 'result is right.' ); } { my $callbackNS = "http://x/x"; my $p = XML::LibXML->new; my $xsltproc = XML::LibXSLT->new; $xsltproc->register_function( $callbackNS, "some_function", sub { my($format) = @_; return $format; } ); $xsltproc->register_function( $callbackNS, "some_function2", sub { my($format) = @_; return $format->[0]; } ); my $xsltdoc = $p->parse_string(<<'EOF'); , , , ; , , , ; EOF my $doc = $p->parse_string(<barzzz EOF my $stylesheet = $xsltproc->parse_stylesheet($xsltdoc); my $result = $stylesheet->transform($doc); my $val = $result->findvalue("/root"); # TEST ok ($val, 'val is true.'); # TEST is ($val, "foo,barzzz,bak,bar;foo,barzzz,bak,bar;barbakzzz", 'val has the right value.') or print $stylesheet->output_as_bytes($result); } { my $ns = "http://foo"; my $p = XML::LibXML->new; my $xsltproc = XML::LibXSLT->new; my $xsltdoc = $p->parse_string(< EOF my $doc = $p->parse_string(< EOF my $stylesheet = $xsltproc->parse_stylesheet($xsltdoc); $stylesheet->register_function($ns, "bar", sub { return $_[0] * 2 }); my $result = $stylesheet->transform($doc); my $val = $result->findvalue("/root"); # TEST is ($val, 20, "contextual register_function" ); } { my $ns = "http://foo"; my $p = XML::LibXML->new; my $xsltproc = XML::LibXSLT->new; my $xsltdoc = $p->parse_string(< EOF my $doc = $p->parse_string(< EOF my $stylesheet = $xsltproc->parse_stylesheet($xsltdoc); $stylesheet->register_element($ns, "bar", sub { return XML::LibXML::Text->new( $_[2]->getAttribute( "value" ) ); }); my $result = $stylesheet->transform($doc); my $val = $result->findvalue("/root"); # TEST is ($val, 10, "contextual register_element"); } # TEST ok(1, 'Reached here.');