#!perl # vim:ts=2:sw=2:et:ft=perl use strict; use warnings; use XML::Descent; use Data::Dumper; use Test::More tests => 4; use Test::Differences; my $td = test_data( do { local $/; } ); # inherit { ok my $p = XML::Descent->new( Input => \$td->{t1} ); my @got = (); $p->on( link => sub { my ( $elem, $attr, $ctx ) = @_; push @got, [ $p->get_path, $attr ]; }, name => sub { my ( $elem, $attr, $ctx ) = @_; push @got, [ $p->get_path, $attr ]; }, nested => sub { my ( $elem, $attr, $ctx ) = @_; $p->on( '*' => sub { my ( $elem, $attr, $ctx ) = @_; push @got, [ '*', $p->get_path, $attr ]; } )->inherit( 'name' )->walk; }, )->walk; my @expect = ( [ '/root/link', { 'href' => 'http://hexten.net/' } ], [ '/root/name', {} ], [ '*', '/root/nested/link', { 'href' => 'http://perl.org/' } ], [ '/root/nested/name', {} ], [ '*', '/root/nested/froob', { 'id' => '2' } ] ); unless ( eq_or_diff \@got, \@expect, 'inherit' ) { diag Dumper( \@got ); } } # before/after { ok my $p = XML::Descent->new( Input => \$td->{t1} ); my @got = (); $p->on( link => sub { my ( $elem, $attr, $ctx ) = @_; push @got, [ $p->get_path, $attr ]; }, name => sub { my ( $elem, $attr, $ctx ) = @_; push @got, [ $p->get_path, $attr ]; }, nested => sub { my ( $elem, $attr, $ctx ) = @_; $p->before( link => sub { push @got, 'before link' } ); $p->after( name => sub { push @got, 'after name' } ); $p->on( froob => sub { my ( $elem, $attr, $ctx ) = @_; push @got, [ $p->get_path, $attr ]; } ); $p->after( froob => sub { push @got, 'after froob' } ); $p->before( froob => sub { push @got, 'before froob' } ); push @got, { scope_handlers => [ $p->scope_handlers ], all_handlers => [ $p->all_handlers ] }; $p->walk; }, )->walk; my @expect = ( [ '/root/link', { 'href' => 'http://hexten.net/' } ], [ '/root/name', {} ], { 'all_handlers' => [ 'froob', 'link', 'name', 'nested' ], 'scope_handlers' => [ 'froob', 'link', 'name' ] }, 'before link', [ '/root/nested/link', { 'href' => 'http://perl.org/' } ], [ '/root/nested/name', {} ], 'after name', 'before froob', [ '/root/nested/froob', { 'id' => '2' } ], 'after froob' ); unless ( eq_or_diff \@got, \@expect, 'before/after' ) { diag Dumper( \@got ); } } sub test_data { my $xml = shift; my $td = {}; my $p = XML::Descent->new( Input => \$xml ); $p->on( test => sub { my ( $elem, $attr, $ctx ) = @_; $td->{ $attr->{id} } = $p->xml; } )->walk; return $td; } __DATA__ Hexten Horse Fingers Perl Providence