#!/usr/bin/env perl
# Test key rewrite
use warnings;
use strict;
use lib 'lib','t';
use TestTools;
use XML::Compile::Schema;
use XML::Compile::Tester;
#use Log::Report mode => 3;
use Test::More tests => 44;
my $schema = XML::Compile::Schema->new( <<__SCHEMA__ );
<schema
targetNamespace="$TestNS"
xmlns="$SchemaNS"
xmlns:me="$TestNS">
<element name="test1">
<complexType>
<sequence>
<element name="t1-E1" type="int"/>
<element name="t1E2" type="int"/>
<element name="t1-e3" type="int"/>
</sequence>
<attribute name="t1-A1" type="int"/>
<attribute name="t1A2" type="int"/>
<attribute name="t1-a3" type="int"/>
</complexType>
</element>
<!-- to be used in substitutionGroup tests-->
<element name="t2a" type="int" />
<element name="t2b" substitutionGroup="me:t2a" />
<element name="test2">
<complexType>
<sequence>
<element ref="me:t2a" />
</sequence>
</complexType>
</element>
</schema>
__SCHEMA__
ok(defined $schema);
### stacked rewrites
my %rewrite_table = ( 't1-e3' => 'Tn3', 't1-a3' => 'Ta3' );
sub rewrite_dash { $_[1] =~ s/\-/_/g; $_[1] };
sub rewrite_lowercase { lc $_[1] }
set_compile_defaults
elements_qualified => 'NONE'
, key_rewrite => [ \%rewrite_table, \&rewrite_dash, \&rewrite_lowercase ];
my %t1a = (t1_e1 => 42, t1e2 => 43, tn3 => 44,
t1_a1 => 45, t1a2 => 46, ta3 => 47);
test_rw($schema, test1 => <<__XML, \%t1a);
<test1 t1-A1="45" t1A2="46" t1-a3="47">
<t1-E1>42</t1-E1>
<t1E2>43</t1E2>
<t1-e3>44</t1-e3>
</test1>
__XML
### pre-defined simplify
set_compile_defaults
elements_qualified => 'NONE'
, key_rewrite => 'SIMPLIFIED';
my %t1b = ( t1_e1 => 45, t1e2 => 46, t1_e3 => 47
, t1_a1 => 48, t1a2 => 49, t1_a3 => 50);
test_rw($schema, test1 => <<__XML, \%t1b);
<test1 t1-A1="48" t1A2="49" t1-a3="50">
<t1-E1>45</t1-E1>
<t1E2>46</t1E2>
<t1-e3>47</t1-e3>
</test1>
__XML
### pre-defined prefixed
set_compile_defaults
elements_qualified => 'NONE'
, key_rewrite => 'PREFIXED'
, prefixes => [ me => $TestNS ]
, elements_qualified => 1
, include_namespaces => 1;
my %t3 = ('me_t1-E1' => 50, 'me_t1E2' => 51, 'me_t1-e3' => 52);
test_rw($schema, test1 => <<__XML, \%t3);
<me:test1 xmlns:me="$TestNS">
<me:t1-E1>50</me:t1-E1>
<me:t1E2>51</me:t1E2>
<me:t1-e3>52</me:t1-e3>
</me:test1>
__XML
### example from the manual-page
set_compile_defaults
key_rewrite => [ qw/PREFIXED SIMPLIFIED/ ]
, prefixes => [ mine => $TestNS ]
, elements_qualified => 'ALL';
my $r4 = reader_create $schema, 'changed prefix', "{$TestNS}test1";
my $x4 = $r4->( <<__XML );
<test1 xmlns="$TestNS">
<t1-E1>60</t1-E1>
<t1E2>61</t1E2>
<t1-e3>62</t1-e3>
</test1>
__XML
is_deeply($x4, {mine_t1_e1 => 60, mine_t1e2 => 61, mine_t1_e3 => 62});
### substitutionGroup
set_compile_defaults
key_rewrite => sub { uc $_[1] }
, include_namespaces => 1
, elements_qualified => 'ALL';
test_rw($schema, test2 => <<__XML, {T2A => 70});
<test2 xmlns="$TestNS">
<t2a>70</t2a>
</test2>
__XML
test_rw($schema, test2 => <<__XML, {T2B => 71});
<test2 xmlns="$TestNS">
<t2b>71</t2b>
</test2>
__XML
my $out = templ_perl $schema, "{$TestNS}test2"
, key_rewrite => sub {uc $_[1]}, skip_header => 1;
# T2B "borrows" type of base type
is($out, <<'__TEMPL');
# Describing complex x0:test2
# {http://test-types}test2
# is an unnamed complex
{ # sequence of T2A
# substitutionGroup x0:t2a
# T2A xs:int
# T2B xs:int
T2A => { T2A => 42 }, }
__TEMPL