The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
use strict;
use warnings;
use Test;

use SOAP::Lite;

my @types1999 = qw(
   anyURI 
   string float double decimal timeDuration recurringDuration uriReference 
   integer nonPositiveInteger negativeInteger long int short byte
   nonNegativeInteger unsignedLong unsignedInt unsignedShort unsignedByte
   positiveInteger timeInstant time timePeriod date month year century 
   recurringDate recurringDay language
);

my @types2001 = qw(
    anyType anyURI
    string float double decimal dateTime timePeriod gMonth gYearMonth gYear
    century gMonthDay gDay duration recurringDuration anyURI
    language integer nonPositiveInteger negativeInteger long int short byte
    nonNegativeInteger unsignedLong unsignedInt unsignedShort unsignedByte
    positiveInteger date time dateTime
);

# types * 3 + extra tests + autotype tests
plan tests => 225;

test_serializer('SOAP::XMLSchema1999::Serializer', @types1999);
test_serializer('SOAP::XMLSchema2001::Serializer', @types2001);

sub test_serializer {
    my $package = shift;
    my @types = @_;

    print "# $package\n";

    for my $type (@types) {
        my $method = "as_$type";
	print "#   $method\n";
	use Data::Dumper;
        my $result = $package->$method('', 'test', $type , {});
	ok $result->[0] eq 'test';
	ok $result->[1]->{ 'xsi:type' };
	ok $result->[2] eq '';
    }

}

# additional tests

ok (SOAP::XMLSchema1999::Serializer->anyTypeValue eq 'ur-type');
my $enc = SOAP::XMLSchema1999::Serializer->as_hex('AA', 'test', 'hex', {});
ok $enc->[2] eq '4141';

$enc = SOAP::XMLSchema1999::Serializer->as_dateTime('AA', 'test', 'FOO', {});
ok $enc->[1]->{'xsi:type'} eq 'xsd:dateTime';
ok $enc->[2] eq 'AA';

$enc = SOAP::XMLSchema1999::Serializer->as_boolean(1, 'test', 'boolean', {});
ok $enc->[2] eq 'true';
$enc = SOAP::XMLSchema1999::Serializer->as_boolean(0, 'test', 'boolean', {});
ok $enc->[2] eq 'false';

$enc = SOAP::XMLSchema1999::Serializer->as_undef(1, 'test', 'boolean', {});
ok $enc eq '1';

$enc = SOAP::XMLSchema1999::Serializer->as_undef(0, 'test', 'boolean', {});
ok $enc eq '0';

$enc = SOAP::XMLSchema1999::Serializer->as_base64(0, 'test', 'string', {});
ok ($enc->[2] eq 'MA==');

print "# encoding/decoding Euro symbol in base64\n";
if ($] < 5.008) {
    print "# Skippng unicode test on perl <5.8 ($])\n";
    ok(1);
    ok(1);
} 
else {
    eval {
        # may fail on old perls
        my $str = chr(8364);
        utf8::encode($str);
        my $enc = SOAP::XMLSchema1999::Serializer->as_base64($str, 'test', 'string', {});
        my $enc2001 = SOAP::XMLSchema2001::Serializer->as_base64Binary($str, 'test', 'string', {});
        use MIME::Base64;
        for ($enc, $enc2001) {
            if ( decode_base64($_->[2]) eq $str ) {
                ok(1);
            }
            else {
                print "$str, ", decode_base64($enc->[2]), "\n";
                ok(0);
            }
        }
    }
}    



eval { SOAP::XMLSchema1999::Serializer->as_string([], 'test', 'string', {}) };
ok $@ =~m{ \A String \s value \s expected }xms;

eval { SOAP::XMLSchema1999::Serializer->as_anyURI([], 'test', 'string', {}) };
ok $@ =~m{ \A String \s value \s expected }xms;

ok ! SOAP::XMLSchema1999::Serializer->DESTROY();

my $serializer = SOAP::Serializer->new();
my $fault_envelope = $serializer->envelope( 
    fault => 'Code', 'string', 'Detail', 'Actor'
);

# Test fault serialization order
ok $fault_envelope =~m{ .+(faultcode).+(faultstring).+(faultactor).+(detail)}x;


$serializer = SOAP::Serializer->new();

print "# autotype tests\n";
$serializer->autotype(1);

my %type_of = (
    'true' => 'xsd:boolean',
    'false' => 'xsd:boolean',
    'rtue' => 'xsd:string',
    'aflse' => 'xsd:string',
    '012345' => 'xsd:string',
    'Hello World' => 'xsd:string',
    'http://example.org' => 'xsd:anyURI',
    '12345' => 'xsd:int',
    '-2147483648' => 'xsd:int',
    '2147483647' => 'xsd:int',
    '2147483648' => 'xsd:long',
    '5999927619709920' => 'xsd:long',
    'P' => 'xsd:string',
    'PT' => 'xsd:string',
    'PT01S' => 'xsd:duration',
);

while (my ($value, $type) = each %type_of) {
    my $result = $serializer->encode_scalar($value, 'test', undef, {});
    print "# $value => $type (result: $result->[1]->{'xsi:type'})\n";
    ok ( $result->[1]->{'xsi:type'} eq $type );
}