# Before `make install' is performed this script should be runnable with
# `make test'. After `make install' it should work as `perl test.pl'

######################### We start with some black magic to print on failure.

# Change 1..1 below to 1..last_test_to_print .
# (It may become useful if the test is moved to ./t subdirectory.)

BEGIN { print "1..27\n"; }
END { print "not ok 1\n" unless $loaded; }
use XML::Parser;
use FileHandle;    # Make 5.10.0 happy.
$loaded = 1;
print "ok 1\n";

######################### End of black magic.

# Insert your test code below (better if it prints "ok 13"
# (correspondingly "not ok 13") depending on the success of chunk 13
# of the test code):

# Test 2

my $parser = new XML::Parser( ProtocolEncoding => 'ISO-8859-1' );
if ($parser) {
    print "ok 2\n";
}
else {
    print "not ok 2\n";
    exit;
}

my @ndxstack;
my $indexok = 1;

# Need this external entity

open( ZOE, '>zoe.ent' );
print ZOE "'cute'";
close(ZOE);

# XML string for tests

my $xmlstring = <<"End_of_XML;";
<!DOCTYPE foo
  [
    <!NOTATION bar PUBLIC "qrs">
    <!ENTITY zinger PUBLIC "xyz" "abc" NDATA bar>
    <!ENTITY fran SYSTEM "fran-def">
    <!ENTITY zoe  SYSTEM "zoe.ent">
   ]>
<foo>
  First line in foo
  <boom>Fran is &fran; and Zoe is &zoe;</boom>
  <bar id="jack" stomp="jill">
  <?line-noise *&*&^&<< ?>
    1st line in bar
    <blah> 2nd line in bar </blah>
    3rd line in bar <!-- Isn't this a doozy -->
  </bar>
  <zap ref="zing" />
  This, '\240', would be a bad character in UTF-8.
</foo>
End_of_XML;

# Handlers
my @tests;
my $pos = '';

sub ch {
    my ( $p, $str ) = @_;
    $tests[4]++;
    $tests[5]++ if ( $str =~ /2nd line/ and $p->in_element('blah') );
    if ( $p->in_element('boom') ) {
        $tests[17]++ if $str =~ /pretty/;
        $tests[18]++ if $str =~ /cute/;
    }
}

sub st {
    my ( $p, $el, %atts ) = @_;

    $ndxstack[ $p->depth ] = $p->element_index;
    $tests[6]++ if ( $el eq 'bar' and $atts{stomp} eq 'jill' );
    if ( $el eq 'zap' and $atts{'ref'} eq 'zing' ) {
        $tests[7]++;
        $p->default_current;
    }
    elsif ( $el eq 'bar' ) {
        $tests[22]++ if $p->recognized_string eq '<bar id="jack" stomp="jill">';
    }
}

sub eh {
    my ( $p, $el ) = @_;
    $indexok = 0 unless $p->element_index == $ndxstack[ $p->depth ];
    if ( $el eq 'zap' ) {
        $tests[8]++;
        my @old = $p->setHandlers( 'Char', \&newch );
        $tests[19]++ if $p->current_line == 17;
        $tests[20]++ if $p->current_column == 20;
        $tests[23]++ if ( $old[0] eq 'Char' and $old[1] == \&ch );
    }
    if ( $el eq 'boom' ) {
        $p->setHandlers( 'Default', \&dh );
    }
}

sub dh {
    my ( $p, $str ) = @_;
    if ( $str =~ /doozy/ ) {
        $tests[9]++;
        $pos = $p->position_in_context(1);
    }
    $tests[10]++ if $str =~ /^<zap/;
}

sub pi {
    my ( $p, $tar, $data ) = @_;

    $tests[11]++ if ( $tar eq 'line-noise' and $data =~ /&\^&<</ );
}

sub note {
    my ( $p, $name, $base, $sysid, $pubid ) = @_;

    $tests[12]++ if ( $name eq 'bar' and $pubid eq 'qrs' );
}

sub unp {
    my ( $p, $name, $base, $sysid, $pubid, $notation ) = @_;

    $tests[13]++ if ( $name eq 'zinger'
        and $pubid eq 'xyz'
        and $sysid eq 'abc'
        and $notation eq 'bar' );
}

sub newch {
    my ( $p, $str ) = @_;

    if ( $] < 5.007001 ) {
        $tests[14]++ if $str =~ /'\302\240'/;
    }
    else {
        $tests[14]++ if $str =~ /'\xa0'/;
    }
}

sub extent {
    my ( $p, $base, $sys, $pub ) = @_;

    if ( $sys eq 'fran-def' ) {
        $tests[15]++;
        return 'pretty';
    }
    elsif ( $sys eq 'zoe.ent' ) {
        $tests[16]++;

        open( FOO, $sys ) or die "Couldn't open $sys";
        return *FOO;
    }
}

eval {
    $parser->setHandlers(
        'Char'         => \&ch,
        'Start'        => \&st,
        'End'          => \&eh,
        'Proc'         => \&pi,
        'Notation'     => \&note,
        'Unparsed'     => \&unp,
        'ExternEnt'    => \&extent,
        'ExternEntFin' => sub { close(FOO); }
    );
};

if ($@) {
    print "not ok 3\n";
    exit;
}

print "ok 3\n";

# Test 4..20
eval { $parser->parsestring($xmlstring); };

if ($@) {
    print "Parse error:\n$@";
}
else {
    $tests[21]++;
}

unlink('zoe.ent') if ( -f 'zoe.ent' );

for ( 4 .. 23 ) {
    print "not " unless $tests[$_];
    print "ok $_\n";
}

$cmpstr = << 'End_of_Cmp;';
    <blah> 2nd line in bar </blah>
    3rd line in bar <!-- Isn't this a doozy -->
===================^
  </bar>
End_of_Cmp;

if ( $cmpstr ne $pos ) {
    print "not ";
}
print "ok 24\n";

print "not " unless $indexok;
print "ok 25\n";

# Test that memory leak through autovivifying symbol table entries is fixed.

my $count = 0;
$parser = new XML::Parser(
    Handlers => {
        Start => sub { $count++ }
    }
);

$xmlstring = '<a><b>Sea</b></a>';

eval { $parser->parsestring($xmlstring); };

if ( $count != 2 ) {
    print "not ";
}
print "ok 26\n";

if ( defined( *{$xmlstring} ) ) {
    print "not ";
}
print "ok 27\n";

BEGIN { print "1..2\n"; }
END { print "not ok 1\n" unless $loaded; }
use XML::Parser;
$loaded = 1;
print "ok 1\n";

my $count = 0;

my $cdata_part = "<<< & > '' << &&&>&&&&;<";

my $doc = "<foo> hello <![CDATA[$cdata_part]]> there</foo>";

my $acc = '';

sub ch {
    my ( $xp, $data ) = @_;

    $acc .= $data;
}

sub stcd {
    my $xp = shift;
    $xp->setHandlers( Char => \&ch );
}

sub ecd {
    my $xp = shift;
    $xp->setHandlers( Char => 0 );
}

$parser = new XML::Parser(
    ErrorContext => 2,
    Handlers     => {
        CdataStart => \&stcd,
        CdataEnd   => \&ecd
    }
);

$parser->parse($doc);

print "not "
  unless ( $acc eq $cdata_part );
print "ok 2\n";

#!/usr/bin/perl

use strict;
use warnings;

use Test::More tests => 40;
use XML::Parser;

ok("loaded");

my $bigval = <<'End_of_bigval;';
This is a large string value to test whether the declaration parser still
works when the entity or attribute default value may be broken into multiple
calls to the default handler.
01234567890123456789012345678901234567890123456789012345678901234567890123456789
01234567890123456789012345678901234567890123456789012345678901234567890123456789
01234567890123456789012345678901234567890123456789012345678901234567890123456789
01234567890123456789012345678901234567890123456789012345678901234567890123456789
01234567890123456789012345678901234567890123456789012345678901234567890123456789
01234567890123456789012345678901234567890123456789012345678901234567890123456789
01234567890123456789012345678901234567890123456789012345678901234567890123456789
01234567890123456789012345678901234567890123456789012345678901234567890123456789
01234567890123456789012345678901234567890123456789012345678901234567890123456789
01234567890123456789012345678901234567890123456789012345678901234567890123456789
01234567890123456789012345678901234567890123456789012345678901234567890123456789
01234567890123456789012345678901234567890123456789012345678901234567890123456789
01234567890123456789012345678901234567890123456789012345678901234567890123456789
End_of_bigval;

$bigval =~ s/\n/ /g;

my $docstr = <<"End_of_Doc;";
<?xml version="1.0" encoding="ISO-8859-1" ?>
<!DOCTYPE foo SYSTEM 't/foo.dtd'
  [
   <!ENTITY alpha 'a'>
   <!ELEMENT junk ((bar|foo|xyz+), zebra*)>
   <!ELEMENT xyz (#PCDATA)>
   <!ELEMENT zebra (#PCDATA|em|strong)*>	
   <!ATTLIST junk
         id ID #REQUIRED
         version CDATA #FIXED '1.0'
         color (red|green|blue) 'green'
         foo NOTATION (x|y|z) #IMPLIED>
   <!ENTITY skunk "stinky animal">
   <!ENTITY big "$bigval">
   <!-- a comment -->
   <!NOTATION gif SYSTEM 'http://www.somebody.com/specs/GIF31.TXT'>
   <!ENTITY logo PUBLIC '//Widgets Corp/Logo' 'logo.gif' NDATA gif>
   <?DWIM a useless processing instruction ?>
   <!ELEMENT bar ANY>
   <!ATTLIST bar big CDATA '$bigval'>
  ]>
<foo/>
End_of_Doc;

my $entcnt = 0;
my %ents;

sub enth1 {
    my ( $p, $name, $val, $sys, $pub, $notation ) = @_;

    is( $val, 'a' )             if ( $name eq 'alpha' );
    is( $val, 'stinky animal' ) if ( $name eq 'skunk' );
    if ( $name eq 'logo' ) {
        ok( !defined($val) );
        is( $sys,      'logo.gif' );
        is( $pub,      '//Widgets Corp/Logo' );
        is( $notation, 'gif' );
    }
}

my $parser = new XML::Parser(
    ErrorContext  => 2,
    NoLWP         => 1,
    ParseParamEnt => 1,
    Handlers      => { Entity => \&enth1 }
);

eval { $parser->parse($docstr) };

sub eleh {
    my ( $p, $name, $model ) = @_;

    if ( $name eq 'junk' ) {
        is( $model, '((bar|foo|xyz+),zebra*)' );
        ok $model->isseq;
        my @parts = $model->children;
        ok( $parts[0]->ischoice );
        my @cparts = $parts[0]->children;
        is( $cparts[0],       'bar' );
        is( $cparts[1],       'foo' );
        is( $cparts[2],       'xyz+' );
        is( $cparts[2]->name, 'xyz' );
        is( $parts[1]->name,  'zebra' );
        is( $parts[1]->quant, '*' );
    }

    if ( $name eq 'xyz' ) {
        ok( $model->ismixed );
        ok( !defined( $model->children ) );
    }

    if ( $name eq 'zebra' ) {
        ok( $model->ismixed );
        is( ( $model->children )[1], 'strong' );
    }

    if ( $name eq 'bar' ) {
        ok( $model->isany );
    }
}

sub enth2 {
    my ( $p, $name, $val, $sys, $pub, $notation ) = @_;

    is( $val, 'a' )             if ( $name eq 'alpha' );
    is( $val, 'stinky animal' ) if ( $name eq 'skunk' );
    is( $val, $bigval )         if ( $name eq 'big' );
    ok( !defined($val) and $sys eq 'logo.gif' and $pub eq '//Widgets Corp/Logo' and $notation eq 'gif' )
      if ( $name eq 'logo' );
}

sub doc {
    my ( $p, $name, $sys, $pub, $intdecl ) = @_;

    is( $name, 'foo' );
    is( $sys,  't/foo.dtd' );
    ok($intdecl);
}

sub att {
    my ( $p, $elname, $attname, $type, $default, $fixed ) = @_;

    if ( $elname eq 'junk' ) {
        if ( $attname eq 'id' and $type eq 'ID' ) {
            is( $default, '#REQUIRED' );
            ok( !$fixed );
        }
        elsif ( $attname eq 'version' and $type eq 'CDATA' ) {
            is( $default, "'1.0'" );
            ok($fixed);
        }
        elsif ( $attname eq 'color' and $type eq '(red|green|blue)' ) {
            is( $default, "'green'" );
        }
        elsif ( $attname eq 'foo' and $type eq 'NOTATION(x|y|z)' ) {
            is( $default, '#IMPLIED' );
        }
    }
    elsif ( $elname eq 'bar' ) {
        is( $attname, 'big' );
        is( $default, "'$bigval'" );
    }
}

sub xd {
    my ( $p, $version, $enc, $stand ) = @_;

    if ( defined($version) ) {
        is( $version, '1.0' );
        is( $enc,     'ISO-8859-1' );
        ok( !defined($stand) );
    }
    else {
        is( $enc, 'x-sjis-unicode' );
    }
}

$parser->setHandlers(
    Entity  => \&enth2,
    Element => \&eleh,
    Attlist => \&att,
    Doctype => \&doc,
    XMLDecl => \&xd
);

$| = 1;
$parser->parse($docstr);

BEGIN { print "1..4\n"; }
END { print "not ok 1\n" unless $loaded; }
use XML::Parser;
$loaded = 1;
print "ok 1\n";

$doc = <<'End_of_Doc;';
<!DOCTYPE foo [
<!ATTLIST bar zz CDATA 'there'>
]>
<foo>
  <bar xx="hello"/>
  <bar zz="other"/>
</foo>
End_of_Doc;

sub st {
    my $xp = shift;
    my $el = shift;

    if ( $el eq 'bar' ) {
        my %atts = @_;
        my %isdflt;
        my $specified = $xp->specified_attr;

        for ( my $i = $specified; $i < @_; $i += 2 ) {
            $isdflt{ $_[$i] } = 1;
        }

        if ( defined $atts{xx} ) {
            print 'not '
              if $isdflt{'xx'};
            print "ok 2\n";

            print 'not '
              unless $isdflt{'zz'};
            print "ok 3\n";
        }
        else {
            print 'not '
              if $isdflt{'zz'};
            print "ok 4\n";
        }

    }
}

$p = new XML::Parser( Handlers => { Start => \&st } );

$p->parse($doc);
BEGIN { print "1..6\n"; }
END { print "not ok 1\n" unless $loaded; }
use XML::Parser;
$loaded = 1;
print "ok 1\n";

################################################################
# Check encoding

my $xmldec = "<?xml version='1.0' encoding='x-sjis-unicode' ?>\n";

my $docstring = <<"End_of_doc;";
<\x8e\x83>\x90\x46\x81\x41\x98\x61\x81\x41\x99\x44
</\x8e\x83>
End_of_doc;

my $doc = $xmldec . $docstring;

my @bytes;
my $lastel;

sub text {
    my ( $xp, $data ) = @_;

    push( @bytes, unpack( 'U0C*', $data ) );    # was fixed 5.10
}

sub start {
    my ( $xp, $el ) = @_;

    $lastel = $el;
}

my $p = XML::Parser->new( Handlers => { Start => \&start, Char => \&text } );

$p->parse($doc);

my $exptag = ( $] < 5.006 )
  ? "\xe7\xa5\x89"    # U+7949 blessings 0x8e83
  : chr(0x7949);

my @expected = (
    0xe8, 0x89, 0xb2,    # U+8272 beauty    0x9046
    0xe3, 0x80, 0x81,    # U+3001 comma     0x8141
    0xe5, 0x92, 0x8c,    # U+548C peace     0x9861
    0xe3, 0x80, 0x81,    # U+3001 comma     0x8141
    0xe5, 0x83, 0x96,    # U+50D6 joy       0x9944
    0x0a
);

if ( $lastel eq $exptag ) {
    print "ok 2\n";
}
else {
    print "not ok 2\n";
}

if ( @bytes != @expected ) {
    print "not ok 3\n";
}
else {
    my $i;
    for ( $i = 0; $i < @expected; $i++ ) {
        if ( $bytes[$i] != $expected[$i] ) {
            print "not ok 3\n";
            exit;
        }
    }
    print "ok 3\n";
}

$lastel = '';

$p->parse( $docstring, ProtocolEncoding => 'X-SJIS-UNICODE' );

if ( $lastel eq $exptag ) {
    print "ok 4\n";
}
else {
    print "not ok 4\n";
}

# Test the CP-1252 Win-Latin-1 mapping

$docstring = qq(<?xml version='1.0' encoding='WINDOWS-1252' ?>
<doc euro="\x80" lsq="\x91" rdq="\x94" />
);

my %attr;

sub get_attr {
    my ( $xp, $el, @list ) = @_;
    %attr = @list;
}

$p = XML::Parser->new( Handlers => { Start => \&get_attr } );

eval { $p->parse($docstring) };

if ($@) {
    print "not ";    # couldn't load the map
}
print "ok 5\n";

if (   $attr{euro} ne ( $] < 5.006 ? "\xE2\x82\xAC" : chr(0x20AC) )
    or $attr{lsq} ne ( $] < 5.006 ? "\xE2\x80\x98" : chr(0x2018) )
    or $attr{rdq} ne ( $] < 5.006 ? "\xE2\x80\x9D" : chr(0x201D) ) ) {
    print "not ";
}
print "ok 6\n";

<!ATTLIST ext type CDATA "flag">
<more/>
#!/usr/bin/perl

use strict;
use warnings;

use Test::More tests => 4;
use XML::Parser;

################################################################
# Check default external entity handler

my $txt = '';

sub txt {
    my ( $xp, $data ) = @_;

    $txt .= $data;
}

my $docstring = <<'End_of_XML;';
<!DOCTYPE foo [
  <!ENTITY a SYSTEM "a.ent">
  <!ENTITY b SYSTEM "b.ent">
  <!ENTITY c SYSTEM "c.ent">
]>
<foo>
a = "&a;"
b = "&b;"


And here they are again in reverse order:
b = "&b;"
a = "&a;"

</foo>
End_of_XML;

my $ent_fh;
open( $ent_fh, '>', 'a.ent' ) or die "Couldn't open a.ent for writing";
print $ent_fh "This ('&c;') is a quote of c";
close($ent_fh);

open( $ent_fh, '>', 'b.ent' ) or die "Couldn't open b.ent for writing";
print $ent_fh "Hello, I'm B";
close($ent_fh);

open( $ent_fh, '>', 'c.ent' ) or die "Couldn't open c.ent for writing";
print $ent_fh "Hurrah for C";
close($ent_fh);

my $p = new XML::Parser( Handlers => { Char => \&txt } );

$p->parse($docstring);

my %check = (
    a => "This ('Hurrah for C') is a quote of c",
    b => "Hello, I'm B"
);

while ( $txt =~ /([ab]) = "(.*)"/g ) {
    my ( $k, $v ) = ( $1, $2 );

    is($check{$k}, $v);
}

unlink('a.ent');
unlink('b.ent');
unlink('c.ent');

use Test::More tests => 1;
use XML::Parser;

my $count = 0;

$parser = XML::Parser->new( ErrorContext => 2 );
$parser->setHandlers( Comment => sub { $count++; } );

$parser->parsefile('samples/REC-xml-19980210.xml');

is( $count, 37 );

use if $] < 5.006, Test::More => skip_all => 'syntax requires perl 5.6';

#tests behaviour on perls 5.10? .. 5.10.1
package Some::Fake::Packege;

sub fake_sub {
    require FileHandle;
}

package main;

use Test::More tests => 1;
use XML::Parser;
use strict;

my $count = 0;

my $parser = XML::Parser->new( ErrorContext => 2 );
$parser->setHandlers( Comment => sub { $count++; } );

open my $fh, '<', 'samples/REC-xml-19980210.xml' or die;

#on 5.10 $fh would be a FileHandle object without a real FileHandle class

$parser->parse($fh);

is( $count, 37 );
BEGIN { print "1..3\n"; }
END { print "not ok 1\n" unless $loaded; }
use XML::Parser;
$loaded = 1;
print "ok 1\n";

my $stcount = 0;
my $encount = 0;

sub st {
    my ( $exp, $el ) = @_;
    $stcount++;
    $exp->finish if $el eq 'loc';
}

sub end {
    $encount++;
}

$parser = new XML::Parser(
    Handlers => {
        Start => \&st,
        End   => \&end
    },
    ErrorContext => 2
);

$parser->parsefile('samples/REC-xml-19980210.xml');

print "not " unless $stcount == 12;
print "ok 2\n";

print "not " unless $encount == 8;
print "ok 3\n";
<?xml encoding="x-sjis-unicode"?>
<!ENTITY joy "™D">

<!ATTLIST foo zz CDATA 'here'>

<!ENTITY % bar 'IGNORE'>
<!ENTITY % foo 'IGNORE'>

<!ENTITY more SYSTEM 'ext2.ent'>

<!ENTITY % ext SYSTEM 'ext.ent'>
%ext;

<![%bar;[
<!ATTLIST bar xyz (a|b|c) 'b'>
]]>

<![%foo;[
<!ATTLIST foo top CDATA "hello">
]]>
BEGIN { print "1..16\n"; }
END { print "not ok 1\n" unless $loaded; }
use XML::Parser;
$loaded = 1;
print "ok 1\n";

################################################################
# Check namespaces

$docstring = <<'End_of_doc;';
<foo xmlns="urn:blazing-saddles"
     xmlns:bar="urn:young-frankenstein"
     bar:alpha="17">
 <zebra xyz="nothing"/>
 <tango xmlns=""
	xmlns:zoo="urn:high-anxiety"
        beta="blue"
        zoo:beta="green"
        bar:beta="red">
   <?nscheck?>
   <zoo:here/>
   <there/>
 </tango>
 <everywhere/>
</foo>
End_of_doc;

my $gname;

sub init {
    my $xp = shift;
    $gname = $xp->generate_ns_name( 'alpha', 'urn:young-frankenstein' );
}

sub start {
    my $xp = shift;
    my $el = shift;

    if ( $el eq 'foo' ) {
        print "not " unless $xp->namespace($el) eq 'urn:blazing-saddles';
        print "ok 2\n";

        print "not " unless $xp->new_ns_prefixes == 2;
        print "ok 3\n";

        while (@_) {
            my $att = shift;
            my $val = shift;
            if ( $att eq 'alpha' ) {
                print "not " unless $xp->eq_name( $gname, $att );
                print "ok 4\n";
                last;
            }
        }
    }
    elsif ( $el eq 'zebra' ) {
        print "not " unless $xp->new_ns_prefixes == 0;
        print "ok 5\n";

        print "not " unless $xp->namespace($el) eq 'urn:blazing-saddles';
        print "ok 6\n";
    }
    elsif ( $el eq 'tango' ) {
        print "not " if $xp->namespace( $_[0] );
        print "ok 8\n";

        print "not " unless $_[0] eq $_[2];
        print "ok 9\n";

        print "not " if $xp->eq_name( $_[0], $_[2] );
        print "ok 10\n";

        my $cnt = 0;
        foreach ( $xp->new_ns_prefixes ) {
            $cnt++ if $_ eq '#default';
            $cnt++ if $_ eq 'zoo';
        }

        print "not " unless $cnt == 2;
        print "ok 11\n";
    }
}

sub end {
    my $xp = shift;
    my $el = shift;

    if ( $el eq 'zebra' ) {
        print "not "
          unless $xp->expand_ns_prefix('#default') eq 'urn:blazing-saddles';
        print "ok 7\n";
    }
    elsif ( $el eq 'everywhere' ) {
        print "not " unless $xp->namespace($el) eq 'urn:blazing-saddles';
        print "ok 16\n";
    }
}

sub proc {
    my $xp     = shift;
    my $target = shift;

    if ( $target eq 'nscheck' ) {
        print "not " if $xp->new_ns_prefixes > 0;
        print "ok 12\n";

        my $cnt = 0;
        foreach ( $xp->current_ns_prefixes ) {
            $cnt++ if $_ eq 'zoo';
            $cnt++ if $_ eq 'bar';
        }

        print "not " unless $cnt == 2;
        print "ok 13\n";

        print "not "
          unless $xp->expand_ns_prefix('bar') eq 'urn:young-frankenstein';
        print "ok 14\n";

        print "not "
          unless $xp->expand_ns_prefix('zoo') eq 'urn:high-anxiety';
        print "ok 15\n";
    }
}

my $parser = new XML::Parser(
    ErrorContext => 2,
    Namespaces   => 1,
    Handlers     => {
        Start => \&start,
        End   => \&end,
        Proc  => \&proc,
        Init  => \&init
    }
);

$parser->parse($docstring);
#!/usr/bin/perl

use strict;
use warnings;

use Test::More tests => 13;
use XML::Parser;

my $internal_subset = <<'End_of_internal;';
[
  <!ENTITY % foo "IGNORE">
  <!ENTITY % bar "INCLUDE">
  <!ENTITY more SYSTEM "t/ext2.ent">
]
End_of_internal;

my $doc = <<"End_of_doc;";
<?xml version="1.0" encoding="ISO-8859-1"?>
<!DOCTYPE foo SYSTEM "t/foo.dtd"
$internal_subset>
<foo>Happy, happy
<bar>&joy;, &joy;</bar>
<ext/>
&more;
</foo>
End_of_doc;

my $bartxt          = '';
my $internal_exists = 0;

sub start {
    my ( $xp, $el, %atts ) = @_;

    if ( $el eq 'foo' ) {
        ok( !defined $atts{top} );
        ok( defined $atts{zz} );
    }
    elsif ( $el eq 'bar' ) {
        is( $atts{xyz}, 'b' );
    }
    elsif ( $el eq 'ext' ) {
        is( $atts{type}, 'flag' );
    }
    elsif ( $el eq 'more' ) {
        pass("got 'more'");
    }
}

sub char {
    my ( $xp, $text ) = @_;

    $bartxt .= $text if $xp->current_element eq 'bar';
}

sub attl {
    my ( $xp, $el, $att, $type, $dflt, $fixed ) = @_;

    ok( ( $att eq 'xyz' and $dflt eq "'b'" ), 'when el eq bar' ) if ( $el eq 'bar' );
    ok( !( $att eq 'top' and $dflt eq '"hello"' ), 'when el eq foo' ) if ( $el eq 'foo' );
}

sub dtd {
    my ( $xp, $name, $sysid, $pubid, $internal ) = @_;

    pass("doctype called");
    $internal_exists = $internal;
}

my $p = new XML::Parser(
    ParseParamEnt => 1,
    ErrorContext  => 2,
    Handlers      => {
        Start   => \&start,
        Char    => \&char,
        Attlist => \&attl,
        Doctype => \&dtd
    }
);

eval { $p->parse($doc) };

if ( $] < 5.006 ) {
    is( $bartxt, "\xe5\x83\x96, \xe5\x83\x96" );
}
else {
    is( $bartxt, chr(0x50d6) . ", " . chr(0x50d6) );
}

ok( $internal_exists, 'internal exists' );

$doc =~ s/[\s\n]+\[[^]]*\][\s\n]+//m;

$p->setHandlers(
    Start => sub {
        my ( $xp, $el, %atts ) = @_;
        if ( $el eq 'foo' ) {
            ok( defined( $atts{zz} ) );
        }
    }
);

$p->parse($doc);
BEGIN { print "1..3\n"; }
END { print "not ok 1\n" unless $loaded; }
use XML::Parser;
$loaded = 1;
print "ok 1\n";

my $cnt = 0;
my $str;

sub tmpchar {
    my ( $xp, $data ) = @_;

    if ( $xp->current_element eq 'day' ) {
        $str = $xp->original_string;
        $xp->setHandlers( Char => 0 );
    }
}

my $p = new XML::Parser(
    Handlers => {
        Comment => sub { $cnt++; },
        Char => \&tmpchar
    }
);

my $xpnb = $p->parse_start;

open( my $rec, '<', 'samples/REC-xml-19980210.xml' );

while (<$rec>) {
    $xpnb->parse_more($_);
}

close($rec);

$xpnb->parse_done;

print "not " unless $cnt == 37;
print "ok 2\n";

print "not " unless $str eq '&draft.day;';
print "ok 3\n";

BEGIN { print "1..4\n"; }
END { print "not ok 1\n" unless $loaded; }
use XML::Parser;
$loaded = 1;
print "ok 1\n";

my $cmnt_count    = 0;
my $pi_count      = 0;
my $between_count = 0;
my $authseen      = 0;

sub init {
    my $xp = shift;
    $xp->skip_until(1);    # Skip through prolog
}

sub proc {
    $pi_count++;
}

sub cmnt {
    $cmnt_count++;
}

sub start {
    my ( $xp, $el ) = @_;
    my $ndx = $xp->element_index;
    if ( !$authseen and $el eq 'authlist' ) {
        $authseen = 1;
        $xp->skip_until(2000);
    }
    elsif ( $authseen and $ndx < 2000 ) {
        $between_count++;
    }
}

my $p = new XML::Parser(
    Handlers => {
        Init    => \&init,
        Start   => \&start,
        Comment => \&cmnt,
        Proc    => \&proc
    }
);

$p->parsefile('samples/REC-xml-19980210.xml');

print "not " if $between_count;
print "ok 2\n";

print "not " if $pi_count;
print "ok 3\n";

print "not " unless $cmnt_count == 5;
print "ok 4\n";

BEGIN { print "1..3\n"; }
END { print "not ok 1\n" unless $loaded; }
use XML::Parser;
$loaded = 1;
print "ok 1\n";

my $delim   = '------------123453As23lkjlklz877';
my $file    = 'samples/REC-xml-19980210.xml';
my $tmpfile = 'stream.tmp';

my $cnt = 0;

open( my $out_fh, '>', $tmpfile ) or die "Couldn't open $tmpfile for output";
open( my $in_fh,  '<', $file )    or die "Couldn't open $file for input";

while (<$in_fh>) {
    print $out_fh $_;
}

close($in_fh);
print $out_fh "$delim\n";

open( $in_fh, $file );
while (<$in_fh>) {
    print $out_fh $_;
}

close($in_fh);
close($out_fh);

my $parser = new XML::Parser(
    Stream_Delimiter => $delim,
    Handlers         => {
        Comment => sub { $cnt++; }
    }
);

open( my $fh, $tmpfile );

$parser->parse($fh);

print "not " if ( $cnt != 37 );
print "ok 2\n";

$cnt = 0;

$parser->parse($fh);

print "not " if ( $cnt != 37 );
print "ok 3\n";

close($fh);
unlink($tmpfile);
use Test;
BEGIN { plan tests => 13 }
use XML::Parser;
use IO::File;

my $xmlstr = '<foo>bar</foo>';

{
    # Debug style
    my $parser = XML::Parser->new( Style => 'Debug' );
    ok($parser);

    my $tmpfile = IO::File->new_tmpfile();
    open( OLDERR, ">&STDERR" );
    open( STDERR, ">&" . $tmpfile->fileno ) || die "Cannot re-open STDERR : $!";

    $parser->parse($xmlstr);

    close(STDERR);
    open( STDERR, ">&OLDERR" );
    close(OLDERR);

    seek( $tmpfile, 0, 0 );
    my $warn = 0;
    $warn++ while (<$tmpfile>);
    ok( $warn, 3, "Check we got three warnings out" );
}

{
    # Object style
    my $parser = XML::Parser->new( Style => 'Objects' );
    ok($parser);

    my $tree = $parser->parse($xmlstr);
    ok($tree);
}

{
    # Stream style
    my $parser = XML::Parser->new( Style => 'Stream' );
    ok($parser);
}

{
    # Subs style
    my $parser = XML::Parser->new( Style => 'Subs' );
    ok($parser);
}

{
    # Tree style
    my $parser = XML::Parser->new( Style => 'Tree' );
    ok($parser);

    my $tree = $parser->parse($xmlstr);
    ok( ref($tree),             'ARRAY' );
    ok( $tree->[0],             'foo' );
    ok( ref( $tree->[1] ),      'ARRAY' );
    ok( ref( $tree->[1]->[0] ), 'HASH' );
    ok( $tree->[1][1],          '0' );
    ok( $tree->[1][2],          'bar' );
}