#!/usr/bin/env perl
# test any and anyAttribute
# any with list of url's is not yet tested.

use warnings;
use strict;

use lib 'lib','t';
use TestTools;

use XML::Compile::Schema;
use XML::Compile::Tester;

use Test::More tests => 82;

my $NS2 = "http://test2/ns";

my $doc = XML::LibXML::Document->new('test doc', 'utf-8');
isa_ok($doc, 'XML::LibXML::Document');
my $root = $doc->createElement('root');
$doc->setDocumentElement($root);
$root->setNamespace('http://x', 'b', 1);

my $schema   = XML::Compile::Schema->new( <<__SCHEMA__ );
<wsdl>

<xs:schema
  targetNamespace="$TestNS"
  xmlns:xs="$SchemaNS"
  xmlns:me="$TestNS"
  elementFormDefault="qualified"
>

<xs:element name="test1" type="xs:int" />

<xs:element name="test2" type="me:tns" />
<xs:complexType name="tns">
  <xs:sequence>
    <xs:element name="tns_e" type="xs:int" />
    <xs:any namespace="##targetNamespace" processContents="lax"
       minOccurs="0" maxOccurs="unbounded" />
  </xs:sequence>
  <xs:attribute name="tns_a" type="xs:int" />
  <xs:anyAttribute namespace="##targetNamespace" processContents="lax" />
</xs:complexType>

<xs:element name="test3" type="me:other" />
<xs:complexType name="other">
  <xs:sequence>
    <xs:element name="other_e" type="xs:int" />
    <xs:any namespace="##other" processContents="lax"
       minOccurs="0" maxOccurs="unbounded" />
  </xs:sequence>
  <xs:attribute name="other_a" type="xs:int" />
  <xs:anyAttribute namespace="##other" processContents="lax" />
</xs:complexType>

<xs:element name="test4" type="me:any" />
<xs:complexType name="any">
  <xs:sequence>
    <xs:element name="any_e" type="xs:int" />
    <xs:any namespace="##any" processContents="lax"
       minOccurs="0" maxOccurs="unbounded" />
  </xs:sequence>
  <xs:attribute name="any_a" type="xs:int" />
  <xs:anyAttribute namespace="##any" processContents="lax" />
</xs:complexType>

</xs:schema>

<schema
 targetNamespace="$NS2"
 xmlns="$SchemaNS"
 xmlns:that="$TestNS">

<attribute name="in_other" type="xs:int" />

</schema>

</wsdl>
__SCHEMA__

ok(defined $schema);
my $error;

set_compile_defaults
    include_namespaces => 1;

my %t2a = (tns_e => 10, tns_a => 11);
test_rw($schema, test2 => <<__XML, \%t2a);
<test2 xmlns="$TestNS" tns_a="11"><tns_e>10</tns_e></test2>
__XML

#
# Take it, in target namespace
#

set_compile_defaults
    include_namespaces => 1
  , any_element   => 'TAKE_ALL'
  , any_attribute => 'TAKE_ALL';

my $r2b = reader_create($schema, test2 => "{$TestNS}test2");
my $h2b = $r2b->( <<__XML);
<test2 xmlns="$TestNS" xmlns:b="http://x" tns_a="11" b:tns_b="12">
  <tns_e>9</tns_e>
  <tns_e>10</tns_e>
</test2>
__XML

is(delete $h2b->{tns_e},  9);
is(delete $h2b->{tns_a}, 11);
my $x2ba = delete $h2b->{"{$TestNS}tns_a"};
my $x2be = delete $h2b->{"{$TestNS}tns_e"};
ok(!keys %$h2b);
ok(defined $x2ba);
ok(defined $x2be);
isa_ok($x2ba, 'XML::LibXML::Attr');
isa_ok($x2be, 'ARRAY');
cmp_ok(scalar(@$x2be), '==', 1);
isa_ok($x2be->[0], 'XML::LibXML::Element');
is($x2ba->toString, ' tns_a="11"');
is($x2be->[0]->toString, '<tns_e>10</tns_e>');

# writer

my $nat_at_type = "{$TestNS}nat_at";
my $nat_at = $doc->createAttributeNS($TestNS, 'nat_at', 24);
ok(defined $nat_at, "create native attribute nat_at");

my $for_at_type = '{http://x}for_at';
my $for_at = $doc->createAttributeNS('http://x', 'for_at', 23);
ok(defined $for_at, "create foreign attribute for_at");
isa_ok($for_at, 'XML::LibXML::Attr');

my $nat_el_type = "{$TestNS}nat_el";
my $nat_el = $doc->createElementNS($TestNS, 'nat_el');
ok(defined $nat_el, "create native element nat_el");
$nat_el->appendText(25);
is($nat_el->toString, '<nat_el xmlns="http://test-types">25</nat_el>');

my $for_el_type = '{http://x}for_el';
my $for_el = $doc->createElementNS('http://x', 'for_el');
ok(defined $for_el, "create foreign element for_el");
isa_ok($for_el, 'XML::LibXML::Element');
$for_el->appendText(26);
is($for_el->toString, '<for_el xmlns="http://x">26</for_el>');

my %h2c = (tns_a => 21, tns_e => 22
  , $nat_at_type => $nat_at, $for_at_type => $for_at
  , $nat_el_type => $nat_el, $for_el_type => $for_el
  );

$error = error_w($schema, test2 => \%h2c);
is($error, "unused tags {http://x}for_at {http://x}for_el at {http://test-types}test2");

#
# Take only other namespace
#

my $r3b = reader_create($schema, test3 => "{$TestNS}test3");
my $h3b = $r3b->( <<__XML);
<test3 xmlns="$TestNS" xmlns:b="http://x" other_a="11" b:other_b="12">
  <other_e>10</other_e>
  <for_el xmlns="http://x">26</for_el>
</test3>
__XML

is(delete $h3b->{other_e}, 10);
is(delete $h3b->{other_a}, 11);

my $x3b = delete $h3b->{"{http://x}other_b"};
ok(defined $x3b);
isa_ok($x3b, 'XML::LibXML::Attr');
is($x3b->toString, ' b:other_b="12"');

my $x3b2 = delete $h3b->{"{http://x}for_el"};
ok(defined $x3b2);
isa_ok($x3b2, 'ARRAY');
cmp_ok(scalar(@$x3b2), '==', 1);
isa_ok($x3b2->[0], 'XML::LibXML::Element');
is($x3b2->[0]->toString, '<for_el xmlns="http://x">26</for_el>');

ok(!keys %$h3b);

# writer error

my %h3c =
 (other_a => 10, other_e => 11
 , $nat_at_type => $nat_at, $for_at_type => $for_at
 , $nat_el_type => $nat_el, $for_el_type => $for_el
 );

$error = error_w($schema, test3 => \%h3c);
is($error, "unused tags {http://test-types}nat_at {http://test-types}nat_el at {http://test-types}test3");

#
# Take any namespace
#

my $r4b = reader_create($schema, test4 => "{$TestNS}test4");
my $h4b = $r4b->( <<__XML);
<test4 xmlns="$TestNS" xmlns:b="http://x" any_a="11" b:any_b="12">
  <any_e>10</any_e>
</test4>
__XML

is(delete $h4b->{any_e}, 10);
is(delete $h4b->{any_a}, 11);

my $x4b = delete $h4b->{"{$TestNS}any_a"};
ok(defined $x4b);
isa_ok($x4b, 'XML::LibXML::Attr');
is($x4b->toString, ' any_a="11"');

my $x4b2 = delete $h4b->{"{http://x}any_b"};
ok(defined $x4b2);
isa_ok($x4b2, 'XML::LibXML::Attr');
is($x4b2->toString, ' b:any_b="12"');

ok(!keys %$h4b);

# writer

my %h4c =
  ( any_a => 10, any_e => 11
  , $nat_at_type => $nat_at
  , $for_at_type => $for_at);

my $w4c = writer_create($schema, test4 => "{$TestNS}test4");
my $h4c = writer_test($w4c, \%h4c);
compare_xml($h4c, <<__XML);
<test4 xmlns="http://test-types" any_a="10" nat_at="24" b:for_at="23">
  <any_e>11</any_e>
</test4>
__XML

set_compile_defaults
    include_namespaces => 1
  , prefixes => [ '' => $TestNS, b => 'http://x' ]
  ;

my %h4d =
  ( any_a => 10, any_e => 11
  , ':nat_at' => $nat_at
  , 'b:for_at' => $for_at
  );

my $w4d = writer_create($schema, test4 => "{$TestNS}test4");
my $h4d = writer_test($w4d, \%h4d);
compare_xml($h4d, <<__XML);
<test4 xmlns="http://test-types" any_a="10" nat_at="24" b:for_at="23">
  <any_e>11</any_e>
</test4>
__XML

#
# Test filter
#

my @filtered;
sub filter_any($$)
{   my ($type, $value) = @_;
    push @filtered, $type;
    ok(defined $type, "filter $type");
    isa_ok($value, 'XML::LibXML::Attr');
    my $flat = $value->toString;
    $type =~ m/_a/ ? ($type, $flat) : ();
};

set_compile_defaults
    include_namespaces => 1
  , any_element        => 'TAKE_ALL'
  , any_attribute      => \&filter_any;

my $r5b = reader_create($schema, test4 => "{$TestNS}test4");
my $h5b = $r5b->( <<__XML);
<test4 xmlns="$TestNS" xmlns:b="http://x" any_a="11" b:any_b="12">
  <any_e>10</any_e>
</test4>
__XML

is(delete $h5b->{any_e}, 10);
is(delete $h5b->{any_a}, 11);

my $x5b = delete $h5b->{"{$TestNS}any_a"};
is($x5b, ' any_a="11"');

my $x5b2 = delete $h5b->{"{http://x}any_b"};
ok(!defined $x5b2);

ok(!keys %$h5b);