The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/usr/bin/perl -w
use strict;

use Carp;

use File::Spec;
use lib File::Spec->catdir(File::Spec->curdir,"t");
use tools;

use XML::Twig;

my $DEBUG=0;
print "1..44\n";

{ # test tag regexp handler
  my @res;
  my $doc=q{<doc><foo_f1/><foo_f2/><foo_f1/><foo_f3/><afoo_f1/><FOO_f4/></doc>};
  my $handlers= { qr/^foo_/ => sub { push @res, $_->tag; },
                  foo_f2    => sub { push @res, uc $_->tag; 0 },
                };
  my $expected= 'foo_f1:FOO_F2:foo_f1:foo_f3';
  XML::Twig->new( twig_handlers => $handlers)->parse( $doc);
  my $res= join( ':', @res);
  is( $res, $expected, "tag regexp handlers");
}

{ # test tag regexp handler with i modifier
  my @res;
  my $doc=q{<doc><foo_f1/><foo_f2/><foo_f1/><foo_f3/><afoo_f1/><FOO_f4/></doc>};
  my $handlers= { qr/^foo_/i => sub { push @res, $_->tag; },
                  foo_f2     => sub { push @res, uc $_->tag; 0 },
                };
  my $expected= 'foo_f1:FOO_F2:foo_f1:foo_f3:FOO_f4';
  XML::Twig->new( twig_handlers => $handlers)->parse( $doc);
  my $res= join( ':', @res);
  is( $res, $expected, "tag regexp handlers");
}

{ # test tag regexp handler with all modifier
  my @res;
  my $doc=q{<doc><foo_f1/><foo_f2/><foo_f1/><foo_f3/><afoo_f1/><FOO_f4/></doc>};
  my $handlers= { qr/^foo_/xism => sub { push @res, $_->tag; },
                  foo_f2     => sub { push @res, uc $_->tag; 0 },
                };
  my $expected= 'foo_f1:FOO_F2:foo_f1:foo_f3:FOO_f4';
  XML::Twig->new( twig_handlers => $handlers)->parse( $doc);
  my $res= join( ':', @res);
  is( $res, $expected, "tag regexp handlers");
}


{ # testing last_descendant
  my $t= XML::Twig->new->parse( '<doc id="doc">
                                   <e3 id="e3">t_e_3</e3>
                                   <e4 id="e4" />
                                   <e id="e1">t_e_1</e>
                                   <e id="e2">t_e_2<n id="n1">t_n</n></e>
                                 </doc>
                                '
                              );
  my %exp2id= ( ''            => 't_n',
                'n'           => 'n1',
                '#ELT'        => 'n1',
                'e'           => 'e2',
                'e[@id="e1"]' => 'e1',
                'e2'          => undef,
              );
  foreach my $exp (sort keys %exp2id)
    { my $expected= $exp2id{$exp};
      is( result( $t->last_elt( $exp)), $expected, "last_elt( $exp)");
      is( result( $t->root->last_descendant( $exp)), $expected, "last_descendant( $exp)");
    }

  # some more tests to check that we stay in te subtree and that we get the last descendant if it is itself
  is( result( $t->last_elt( 'e3')), 'e3', 'last_elt( e3)');
  is( result( $t->root->last_descendant( 'e3')), 'e3', 'last_descendant( e3)');
  is( result( $t->root->first_child( 'e3')->last_descendant( 'e3')), 'e3', 'last_descendant( e3) (on e3)');
  is( result( $t->root->first_child( 'e3')->last_descendant()), 't_e_3', 'last_descendant() (on e3)');
  is_undef( $t->root->last_child->last_descendant( 'e3'), 'last_descendant (no result)');

  is( result( $t->root->first_child( 'e4')->last_descendant( 'e4')), 'e4', 'last_descendant( e4) (on e4)');
  is( result( $t->root->first_child( 'e4')->last_descendant( )), 'e4', 'last_descendant( ) (on e4)');

  sub result
    { my( $elt)= @_;
      return undef unless $elt;
      return $elt->id || $elt->text;
    }
}        

{# testing trim
  my $expected;
  while( <DATA>)
    { chomp;
      next unless( m{\S});
      if( s{^#}{}) { $expected= $_; }
      is( XML::Twig->new->parse( $_)->trim->root->sprint, $expected, "trimming '$_'");
    }
}

{ # testing children_trimmed_text
  my $t = XML::Twig->new; 
  $t->parse("<o><e> hell </e><i> foo </i><e> o, \n   world</e></o>"); 
  is( join( ':', $t->root->children_trimmed_text("e")), "hell:o, world" , "children_trimmed_text (list context)");
  my $scalar= $t->root->children_trimmed_text("e");
  is( $scalar, "hello, world" , "children_trimmed_text (scalar context)");
  is( join( ':', $t->root->children_text("e")), " hell : o, \n   world" , "children_text (list context)");
  $scalar= $t->root->children_text("e");
  is( $scalar, " hell  o, \n   world" , "children_text (scalar context)");
}


__DATA__
#<doc>text1 text2</doc>
<doc>  text1 text2</doc>
<doc>   text1 text2</doc>
<doc>text1 text2 </doc>
<doc>text1 text2  </doc>
<doc>text1 text2   </doc>
<doc>text1  text2</doc>
<doc> text1  text2 </doc>
<doc>  text1   text2  </doc>

#<doc>text1 <e>text2</e> text3</doc>
<doc>text1  <e>text2</e> text3 </doc>


#<doc>text1 <e> text2 </e> text3</doc>
<doc>text1  <e>  text2  </e>  text3 </doc>

#<doc><![CDATA[text1 text2]]></doc>
<doc> <![CDATA[text1  text2]]> </doc>
<doc><![CDATA[ text1  text2 ]]></doc>

#<doc>text <b> hah! </b> yep</doc>
<doc>  text <b>  hah! </b>  yep</doc>