use Test; use XML::Filter::Essex; use XML::SAX::PurePerl; use XML::SAX::Writer; BEGIN { eval "use Test::Differences;1" || eval "sub eq_or_diff { goto &ok }"; } @Foo::ISA = qw( XML::Filter::Essex ); sub Foo::main { "Result Value"; } use strict; my ( $p, $h, $w ); my ( $out, $result ); sub t { my @main; @main = ( Main => shift ) if @_ && ref $_[0] eq "CODE"; my $doc; $doc = pop if @_ && ref $_[-1] eq "SCALAR"; my %opts = @_; $h = XML::Filter::Essex->new( @main, %opts ); $out = undef; $h->set_handler( XML::SAX::Writer->new( Output => \$out ) ) unless $opts{Handler}; $result = undef; if ( defined $doc ) { $p = XML::SAX::PurePerl->new( Handler => $h ); $result = $p->parse_string( $$doc ); } else { $result = $h->execute; } return defined $out ? $out : $result; } my @tests = ( sub { ok 1, }, sub { ok t( sub { 1 }, \"" ), 1; }, sub { ok t( sub { put start_doc, start_elt( "foo", { "a" => 1 } ), end_elt( "foo" ), end_doc; }, ), qr{\A\z}; }, sub { ok $result, \$out }, ## X:S:W returns the scalar ref # Several basic get/put loops sub { ok t( sub { put get while 1; }, \"" ), qr{\A\z}; }, sub { ok $result, \$out }, sub { ok t( sub { put while get; }, \"" ), qr{\A\z}; }, sub { ok $result, \$out }, sub { ok t( sub { put get until isa "end_doc"; }, \"" ), qr{\A\z}; }, sub { ok $result, \$out }, sub { ok t( sub { while (1) { get; return put if isa "end_doc"; put; } }, \"" ), qr{\A\z}; }, # put() sub { ok t( sub { put start_doc, [ foo => { a => "b" }, "bar" ], end_doc; }, ), qr{bar}; }, # put()'s missing end_element insertion sub { ok t( sub { put start_doc, start_elt( "foo" ), end_elt, end_doc; }, ), qr{}; }, # path() sub { eq_or_diff t( sub { put start_doc, start_elt( "out" ), "\n"; while (1) { get; put "$_", path, "\n" if isa "start_elt"; last if isa "end_doc"; } put end_elt, "\n", end_doc; }, \"" ), < <foo>/foo END_PATHS }, sub { ok $result, \$out }, # Get something that doesn't exist; see if the doc is passed through sub { ok t( sub { get "processing-instruction()"; }, \"" ), qr{\A\z}; }, sub { ok $result, \$out }, ); plan tests => 0+@tests; $_->() for @tests;