package tests::XMLParserTest;

use strict;

use base qw/Lire::Test::TestCase/;

use Lire::XMLParser;
use Lire::Test::Mock;
use Lire::Utils qw/tempdir create_file/;
use Class::Inner;

sub new {
    my $self = shift->SUPER::new( @_ );

    return $self;
}

sub set_up {
    my $self = $_[0];
    $self->SUPER::set_up();

    $self->{'expat'} = new Lire::Test::Mock( 'XML::Parser::Expat' );
    $self->{'expat'}->set_result( 'xpcroak' => sub { shift; die @_ },
                                  'xpcarp' => sub { shift; warn @_ } );
    return;
}

sub tear_down {
    my $self = $_[0];
    $self->SUPER::tear_down();

    $self->{'expat'}->clean_symbol_table();

    return;
}

sub test_new {
    my $self = $_[0];

    my $parser = new Lire::XMLParser();
    $self->assert_isa( 'Lire::XMLParser', $parser );
    $self->assert_deep_equals( {}, $parser->{'_xml_collectors'} );
    $self->assert_deep_equals( {}, $parser->{'_xml_stacks'} );
}

sub test_Init {
    my $self = $_[0];

    my $parser = new Lire::Test::Mock( 'Lire::XMLParser' );
    $self->{'expat'}{'_LireXMLParser'} = $parser;
    Lire::XMLParser::Init( $self->{'expat'} );
    $self->assert_str_equals( $self->{'expat'}, $parser->{'_xml_expat'} );
    $self->assert_deep_equals( [ '_build_ns_maps',
                                 '_build_dtd',
                                 'parse_start' ], $parser->get_calls() );
    $self->assert_deep_equals( [ $parser ],
                               $parser->get_invocation( 'parse_start' ) );
}

sub test_Start {
    my $self = $_[0];

    my $parser = new_proxy Lire::Test::Mock( 'Lire::XMLParser' );
    $self->{'expat'}{'_LireXMLParser'} = $parser;
    $parser->{'_xml_expat'} = $self->{'expat'};
    $parser->{'_xml_ns2prefix'}{'mynamespace'} = 'lire';
    $parser->{'_xml_elements'} = { 'lire:report' =>
                                   { 'content' => { 'lire:subreport' => 1 } },
                                   'lire:subreport' =>
                                   { 'content' => {} },
                                   'lire:other' =>
                                   { 'content' => {} },
                                 };
    $self->{'expat'}->set_result( 'namespace' => 'mynamespace',
                                  'current_element' => undef );
    $self->assert_dies( qr/encountered unknown element 'lire:unknown'/,
                        sub { Lire::XMLParser::Start( $self->{'expat'}, 'unknown'  ) } );

    Lire::XMLParser::Start( $self->{'expat'}, 'report'  );
    $self->assert_num_equals( 1, $parser->invocation_count( 'element_start' ));
    $self->assert_deep_equals( [ $parser, 'lire:report', {} ],
                               $parser->get_invocation( 'element_start' ));

    $self->{'expat'}->set_result( 'current_element' => 'report' );
    $self->assert_dies( qr/'lire:other' element cannot appear in the context of 'lire:report'/,
                        sub { Lire::XMLParser::Start( $self->{'expat'}, 'other'  ) } );

    Lire::XMLParser::Start( $self->{'expat'}, 'subreport', 'attr' => 'value' );
    $self->assert_num_equals( 2, $parser->invocation_count( 'element_start' ));
    $self->assert_deep_equals( [ $parser, 'lire:subreport',
                                 { 'attr' => 'value' } ],
                               $parser->get_invocation( 'element_start' , 1 ));
}

sub test_End {
    my $self = $_[0];

    my $parser = new_proxy Lire::Test::Mock( 'Lire::XMLParser' );
    $self->{'expat'}{'_LireXMLParser'} = $parser;
    $parser->{'_xml_expat'} = $self->{'expat'};
    $parser->{'_xml_ns2prefix'}{'mynamespace'} = 'lire';
    $self->{'expat'}->set_result( 'namespace' => 'mynamespace' );

    Lire::XMLParser::End( $self->{'expat'}, 'report'  );
    $self->assert_num_equals( 1, $parser->invocation_count( 'element_end' ));
    $self->assert_deep_equals( [ $parser, 'lire:report' ],
                               $parser->get_invocation( 'element_end' ));
}

sub test_Char {
    my $self = $_[0];

    my $parser = new_proxy Lire::Test::Mock( 'Lire::XMLParser' );
    $self->{'expat'}{'_LireXMLParser'} = $parser;
    $parser->{'_xml_expat'} = $self->{'expat'};
    $parser->{'_xml_elements'} = { 'caution' => { 'content' => { 'para' => 1}},
                                   'para' => { 'content' => { 'PCDATA' => 1}}};

    $self->{'expat'}->set_result( 'current_element' => 'para' );
    Lire::XMLParser::Char( $self->{'expat'}, 'report'  );
    $self->assert_num_equals( 1, $parser->invocation_count( 'pcdata' ) );
    $self->assert_deep_equals( [ $parser, 'report' ],
                               $parser->get_invocation( 'pcdata' ) );

    $self->{'expat'}->set_result( 'current_element' => 'caution' );
    $self->assert_dies( qr/non-white space character in element 'caution' which cannot contain PCDATA/,
                        sub { Lire::XMLParser::Char( $self->{'expat'}, 'a char'  ) } );

    Lire::XMLParser::Char( $self->{'expat'}, "\t\n    "  );
    $self->assert_num_equals( 1, $parser->invocation_count( 'ignorable_ws' ) );
    $self->assert_deep_equals( [ $parser, "\t\n    " ],
                               $parser->get_invocation( 'ignorable_ws' ) );
}

sub test_Final {
    my $self = $_[0];

    my $parser = new Lire::Test::Mock( 'Lire::XMLParser',
                                       'parse_end' => 'called' );
    $parser->{'_xml_expat'} = 1;
    my $result = Lire::XMLParser::Final( { '_LireXMLParser' => $parser } );
    $self->assert_str_equals( 'called', $result );
    $self->assert_deep_equals( [ 'parse_end' ], $parser->get_calls() );
    $self->assert_deep_equals( [ $parser ],
                               $parser->get_invocation( 'parse_end' ) );
    $self->assert_null( $parser->{'_xml_expat'}, "_xml_expat != undef" );
}

sub test__build_ns_maps {
    my $self = $_[0];

    my $parser = new_proxy Lire::Test::Mock( 'Lire::XMLParser' );
    $parser->set_result( 'namespaces' =>  { 'http://mynamespace/' => 'lire',
                                            'http://otherna/' => 'ns' } );
    $parser->_build_ns_maps();
    $self->assert_deep_equals( { 'lire' => 'http://mynamespace/',
                                 'ns' => 'http://otherna/' },
                               $parser->{'_xml_prefix2ns'} );
    $self->assert_deep_equals( { 'http://mynamespace/' => 'lire',
                                 'http://otherna/' => 'ns' },
                               $parser->{'_xml_ns2prefix'} );

    $parser->set_result( 'namespaces' => { 'http://mynamespace/' => '' } );
    $self->assert_dies( qr/missing prefix/,
                        sub { $parser->_build_ns_maps() } );

    $parser->set_result( 'namespaces' => { 'http://mynamespace/' => '0' } );
    $self->assert_dies( qr/invalid prefix/,
                        sub { $parser->_build_ns_maps() } );

    $parser->set_result( 'namespaces' => { 'http://mynamespace/' => 'lire',
                                           'other_ns' => 'lire' } );
    $self->assert_dies( qr/prefix \'lire\' already used/,
                        sub { $parser->_build_ns_maps() } );
}

sub test__build_dtd {
    my $self = $_[0];

    my $parser =
      new Class::Inner( 'parent' => 'Lire::XMLParser',
                        'methods' =>
                        { 'elements_spec' => sub { return $_[0]->{'spec'} },
                          'element_start' => sub {},
                          'element_char' => sub {},
                          'element_end' => sub {},
                          'a_method' => sub {},
                          'report_spec_start' => sub {},
                         } );
    $parser->{'_xml_prefix2ns'} = { 'lire' => 'mynamespace' };
    my $sub = sub {};
    $parser->{'spec'} =
      { 'lire:report-spec' => { 'content' => [ 'lire:element', 'other' ] },
        'lire:element' => [ 'PCDATA' ],
        'other' => { 'start' => $sub,
                     'end' => 'a_method' },
      };
    $parser->{'_xml_expat'} = $self->{'expat'};
    $self->{'expat'}->set_result( 'generate_ns_name' =>
                                  sub { return "$_[2]/$_[1]" } );
    $parser->_build_dtd();
    $self->assert_deep_equals( { 'lire:report-spec' =>
                                 { 'content' => { 'lire:element' => 1,
                                                  'other' => 1 },
                                   'start' => $parser->can( 'report_spec_start' ),
                                   'end' => undef,
                                   'char' => undef,
                                   'expat_name' => "mynamespace/report-spec",
                                 },
                                 'lire:element' =>
                                 {
                                  'content' => { 'PCDATA' => 1 },
                                  'start' => $parser->can( 'element_start' ),
                                  'end' => $parser->can( 'element_end' ),
                                  'char' => $parser->can( 'element_char' ),
                                   'expat_name' => "mynamespace/element",
                                 },
                                 'other' =>
                                 {
                                  'content' => {},
                                  'start' => $sub,
                                  'char' => undef,
                                  'end' => $parser->can( 'a_method' ),
                                   'expat_name' => "/other",
                                 },
                               },
                               $parser->{'_xml_elements'} );
    $parser->{'spec'}{'other'}{'content'} = [ 'no_such_element' ];
    $self->assert_dies( qr/element 'no_such_element' used in content of 'other' isn't defined by elements_spec/,
                        sub { $parser->_build_dtd() } );
    delete $parser->{'spec'}{'other'}{'content'};
    $parser->{'_xml_prefix2ns'} = {};
    $self->assert_dies( qr/prefix 'lire' isn't defined by namespaces/,
                        sub { $parser->_build_dtd() } );
}

sub test__prefixed_name {
    my $self = $_[0];

    my $parser = new Lire::XMLParser();
    $parser->{'_xml_expat'} = $self->{'expat'};
    $self->{'expat'}->set_result( 'namespace' => undef );
    $self->assert_str_equals( 'name', $parser->_prefixed_name( 'name' ) );

    $self->{'expat'}->set_result( 'namespace' => 'mynamespace' );
    $parser->{'_xml_ns2prefix'} = { 'mynamespace' => 'lire' };
    $self->assert_str_equals( 'lire:name', $parser->_prefixed_name( 'name' ) );

    $self->{'expat'}->set_result( 'namespace' => 'otherns' );
    $self->assert_dies( qr/namespace 'otherns' wasn't defined by namespaces/,
                        sub{  $parser->_prefixed_name( 'name' ) } );
}

sub test__find_handler {
    my $self = $_[0];

    my $parser =
      new Class::Inner( 'parent' => 'Lire::XMLParser',
                        'methods' =>
                        { 'test_start' => sub {},
                          'a_method' => sub {},
                        } );

    my $sub = sub {};
    $self->assert_str_equals( $sub,
                              $parser->_find_handler( $sub, 'test_start' ) );
    $self->assert_str_equals( $parser->can( 'a_method' ),
                              $parser->_find_handler( 'a_method' ) );
    $self->assert_dies( qr/no handler 'no_method' defined in/,
                        sub { $parser->_find_handler( 'no_method' ) } );
    $self->assert_str_equals( $parser->can( 'test_start' ),
                              $parser->_find_handler( undef, 'test_start' ) );
}

sub test_in_element {
    my $self = $_[0];

    my $parser = new Lire::XMLParser();
    $parser->{'_xml_elements'}{'lire:report'}{'expat_name'} = 'myname';
    $parser->{'_xml_expat'} = $self->{'expat'};
    $self->assert_dies( qr/no element 'wawa' defined by elements_spec/,
                        sub { $parser->in_element( 'wawa' ) } );
    $parser->in_element( 'lire:report' );
    $self->assert_deep_equals( [ $self->{'expat'}, 'myname' ], 
                               $self->{'expat'}->get_invocation( 'in_element' ) );
}

sub test_within_element {
    my $self = $_[0];

    my $parser = new Lire::XMLParser();
    $parser->{'_xml_elements'}{'lire:report'}{'expat_name'} = 'myname';
    $parser->{'_xml_expat'} = $self->{'expat'};
    $self->assert_dies( qr/no element 'wawa' defined by elements_spec/,
                        sub { $parser->within_element( 'wawa' ) } );
    $parser->within_element( 'lire:report' );
    $self->assert_deep_equals( [ $self->{'expat'}, 'myname' ],
                               $self->{'expat'}->get_invocation( 'within_element' ) );
}

sub test_element_start {
    my $self = $_[0];

    my $parser = new Lire::XMLParser();
    $parser->{'_xml_elements'}{'lire:report'}{'start'}
      = sub { $_[0]->{'called'} = \@_ };
    $parser->{'_xml_elements'}{'para'}{'start'} = undef;

    $parser->element_start( 'para' ); # Should just work
    my $attr = {};
    $parser->element_start( 'lire:report', $attr );
    $self->assert( exists $parser->{'called'}, "handler wasn't called" );
    $self->assert_deep_equals( [ $parser, 'lire:report', $attr ],
                               $parser->{'called'} );
}

sub test_element_end {
    my $self = $_[0];

    my $parser = new Lire::XMLParser();
    $parser->{'_xml_elements'}{'lire:report'}{'end'}
      = sub { $_[0]->{'called'} = \@_ };
    $parser->{'_xml_elements'}{'para'}{'end'} = undef;

    $parser->element_end( 'para' ); # Should just work
    $parser->element_end( 'lire:report' );
    $self->assert( exists $parser->{'called'}, "handler wasn't called" );
    $self->assert_deep_equals( [ $parser, 'lire:report' ],
                               $parser->{'called'} );
}

sub test_pcdata {
    my $self = $_[0];

    my $parser = new Lire::XMLParser();
    $parser->{'_xml_expat'} = $self->{'expat'};
    $parser->{'_xml_elements'}{'lire:report'}{'char'}
      = sub { $_[0]->{'called'} = \@_ };
    $parser->{'_xml_elements'}{'para'}{'char'} = undef;

    $self->{'expat'}->set_result( 'current_element', 'para' );
    $parser->pcdata( 'text' ); # Should just work

    $self->{'expat'}->set_result( 'current_element', 'lire:report' );
    $parser->pcdata( 'text' );
    $self->assert( exists $parser->{'called'}, "handler wasn't called" );
    $self->assert_deep_equals( [ $parser, 'text' ], $parser->{'called'} );
}

sub test_init_collector {
    my $self = $_[0];

    my $parser = new Lire::XMLParser();
    $parser->init_collector( 'mycollector' );
    $self->assert_str_equals( '',
                              $parser->{'_xml_collectors'}{'mycollector'} );
}

sub test_collect {
    my $self = $_[0];

    my $parser = new_proxy Lire::Test::Mock( 'Lire::XMLParser' );
    $parser->set_result( 'error' => sub { shift; die @_ } );
    $self->assert_dies( qr/no collector 'unknown' defined/,
                        sub { $parser->collect( 'unknown', 'test' ) } );
    $parser->{'_xml_collectors'}{'test'} = 'some_string';
    $parser->collect( 'test', ' another string' );
    $self->assert_str_equals( 'some_string another string',
                              $parser->{'_xml_collectors'}{ 'test' } );
}

sub test_get_collector {
    my $self = $_[0];

    my $parser = new_proxy Lire::Test::Mock( 'Lire::XMLParser' );
    $parser->set_result( 'error' => sub { shift; die @_ } );
    $self->assert_dies( qr/no collector 'unknown' defined/,
                        sub { $parser->get_collector( 'unknown' ) } );
    $parser->{'_xml_collectors'}{'test'} = '';
    $self->assert_str_equals( '', $parser->get_collector( 'test' ) );
}

sub test_collector_start {
    my $self = $_[0];

    my $parser = new_proxy Lire::Test::Mock( 'Lire::XMLParser' );
    $parser->collector_start( 'lire:test' );
    $self->assert_str_equals( '', $parser->get_collector( 'lire:test' ) );
}

sub test_collector_char {
    my $self = $_[0];

    my $parser = new_proxy Lire::Test::Mock( 'Lire::XMLParser' );
    $parser->set_result( 'current_element' => 'lire:test' );
    $parser->{'_xml_collectors'}{'lire:test'} = '';
    $parser->collector_char( 'test' );
    $self->assert_str_equals( 'test', $parser->get_collector( 'lire:test' ) );
}

sub test_init_stack {
    my $self = $_[0];

    my $parser = new Lire::XMLParser();
    $parser->init_stack( 'stack' );
    $self->assert_deep_equals( [],
                               $parser->{'_xml_stacks'}{'stack'} );
}

sub test_is_stack_empty {
    my $self = $_[0];

    my $parser = new_proxy Lire::Test::Mock( 'Lire::XMLParser' );
    $parser->set_result( 'error' => sub { shift; die @_ }  );
    $self->assert_dies( qr/no stack 'test' defined/,
                        sub { $parser->is_stack_empty( 'test' ) } );
    $parser->{'_xml_stacks'}{'test'} = [];
    $self->assert( $parser->is_stack_empty( 'test' ), 'is_stack_empty()' );
    $parser->{'_xml_stacks'}{'test'} = [ undef ];
    $self->assert( !$parser->is_stack_empty( 'test' ), '!is_stack_empty()' );
}

sub test_stack_depth {
    my $self = $_[0];

    my $parser = new_proxy Lire::Test::Mock( 'Lire::XMLParser' );
    $parser->set_result( 'error' => sub { shift; die @_ }  );
    $self->assert_dies( qr/no stack 'test' defined/,
                        sub { $parser->stack_depth( 'test' ) } );
    $parser->{'_xml_stacks'}{'test'} = [];
    $self->assert_num_equals( 0, $parser->stack_depth( 'test' ) );
    $parser->{'_xml_stacks'}{'test'} = [ undef ];
    $self->assert_num_equals( 1, $parser->stack_depth( 'test' ) );
}

sub test_stack_push {
    my $self = $_[0];

    my $parser = new_proxy Lire::Test::Mock( 'Lire::XMLParser' );
    $parser->set_result( 'error' => sub { shift; die @_ }  );
    $self->assert_dies( qr/no stack 'unknown' defined/,
                        sub { $parser->stack_push( 'unknown', {} ) } );
    $parser->{'_xml_stacks'}{'test'} = [];
    $parser->stack_push( 'test', 'test' );
    $self->assert_deep_equals( [ 'test' ], $parser->{'_xml_stacks'}{'test'} );
}

sub test_stack_pop {
    my $self = $_[0];

    my $parser = new_proxy Lire::Test::Mock( 'Lire::XMLParser' );
    $parser->set_result( 'error' => sub { shift; die @_ }  );
    $self->assert_dies( qr/no stack 'test' defined/,
                        sub { $parser->stack_pop( 'test' ) } );
    $parser->{'_xml_stacks'}{'test'} = [];
    $self->assert_dies( qr/stack 'test' is empty/,
                        sub { $parser->stack_pop( 'test' ) } );
    $parser->{'_xml_stacks'}{'test'} = [ 'test' ];
    $self->assert_str_equals( 'test', $parser->stack_pop( 'test' ) );
    $self->assert_deep_equals( [], $parser->{'_xml_stacks'}{'test'} );
}

sub test_stack_peek {
    my $self = $_[0];

    my $parser = new_proxy Lire::Test::Mock( 'Lire::XMLParser' );
    $parser->set_result( 'error' => sub { shift; die @_ }  );
    $self->assert_dies( qr/no stack 'test' defined/,
                        sub { $parser->stack_peek( 'test' ) } );
    $parser->{'_xml_stacks'}{'test'} = [];
    $self->assert_dies( qr/stack 'test' is empty/,
                        sub { $parser->stack_peek( 'test' ) } );
    $parser->{'_xml_stacks'}{'test'} = [ 'test' ];
    $self->assert_str_equals( 'test', $parser->stack_peek( 'test' ) );
    $self->assert_deep_equals( [ 'test' ], $parser->{'_xml_stacks'}{'test'} );
}

sub test_parse {
    my $self = $_[0];

    my $parser = tests::XMLParserTest::BasicParser->new();
    my $result = $parser->parse( <<EOF );
<?xml version="1.0"?>
<lire:report xmlns:lire="http://www.logreport.org/">
 <lire:subreport>
   <title>A title</title>
 </lire:subreport>
</lire:report>
EOF
    $self->assert_deep_equals( [ 'lire:report', 'lire:subreport', 'A title' ],
                               $result );
}

sub test_parsefile {
    my $self = $_[0];

    my $dir = tempdir( 'parsefile_XXXXXX', 'CLEANUP' => 1 );
    create_file( "$dir/test.xml", <<EOF );
<?xml version="1.0"?>
<lire:report xmlns:lire="http://www.logreport.org/">
 <lire:subreport>
   <title>A title</title>
 </lire:subreport>
</lire:report>
EOF
    my $parser = tests::XMLParserTest::BasicParser->new();
    $self->assert_deep_equals( [ 'lire:report', 'lire:subreport', 'A title' ],
                               $parser->parsefile( "$dir/test.xml" ) );
}

package tests::XMLParserTest::BasicParser;

use base qw/Lire::XMLParser/;

sub namespaces {
    return { 'http://www.logreport.org/' => 'lire' };
}

sub elements_spec {
    return { 'lire:report' => [ 'lire:subreport' ],
             'lire:subreport' => { 'content' => [ 'title' ],
                                   'start' => 'report_start' },
             'title' => [ 'PCDATA' ] };
}

sub parse_start {
    my $self = $_[0];

    $self->{'result'} = [];

    return;
}

sub parse_end {
    return $_[0]{'result'};
}

sub report_start {
    my ( $self, $name, $attr ) = @_;

    push @{$self->{'result'}}, $name;

}

sub title_char {
   my ( $self, $text ) = @_;

   push @{$self->{'result'}}, $text;
}

1;