SOAP-Lite

 view release on metacpan or  search on metacpan

t/02-payload.t  view on Meta::CPAN

</soap:Envelope>
');

  ok($deserialized->namespaceuriof(SOAP::SOM::method) eq 'http://simon.fell.com/calc');
  ok($deserialized->namespaceuriof('//doublerResponse') eq 'http://simon.fell.com/calc');
}

{ # check for Array of Array serialization
  print "Array of Array serialization test(s)...\n";

  $serialized = SOAP::Serializer
    ->readable(1)
    ->method('mymethod' => [[1, 2], [3, 4]]);
  ok($serialized =~ m!soapenc:arrayType="soapenc:Array\[2\]"!);
}

{ # check for serialization with SOAPStruct
  print "Serialization w/out SOAPStruct test(s)...\n";
  $a = { a => 1 };
  $serialized = SOAP::Serializer->namespaces({})->serialize($a);
  ok($serialized =~ m!<c-gensym(\d+)><a xsi:type="xsd:int">1</a></c-gensym\1>!);
}

{ # check header/envelope serialization/deserialization
  print "Header/Envelope serialization/deserialization test(s)...\n";

  $serialized = SOAP::Serializer->method( # same as ->envelope(method =>
      'mymethod', 1, 2, 3,
      SOAP::Header->name(t1 => 5)->mustUnderstand(1)->uri('http://namespaces.soaplite.com/headers'),
      SOAP::Header->name(t2 => 7)->mustUnderstand(2),
  );
  $deserialized = SOAP::Deserializer->deserialize($serialized);

  my $t1 = $deserialized->match(SOAP::SOM::header)->headerof('t1');
  my $t2 = $deserialized->dataof('t2');
  my $t3 = eval { $deserialized->headerof(SOAP::SOM::header . '/{http://namespaces.soaplite.com/headers}t3'); };

  ok(!$@ && !defined $t3);

  my @paramsin = $deserialized->paramsin;
  my @paramsall = $deserialized->paramsall;

  ok($t2->type =~ /^int$/);
  ok($t2->mustUnderstand == 1);
  ok(@paramsin == 3);
  ok(@paramsall == 3);

  eval { $deserialized->result(1) };
  ok($@ =~ /Method 'result' is readonly/);

  $serialized = SOAP::Serializer->method( # same as ->envelope(method =>
      SOAP::Data->name('mymethod')->attr({something => 'value'}), 1, 2, 3,
  );
  ok($serialized =~ /<mymethod something="value">/);

  $serialized = SOAP::Serializer
    -> envprefix('')
    -> method('mymethod');

  ok($serialized =~ m!<Envelope(?: xmlns:namesp\d+="http://schemas.xmlsoap.org/soap/envelope/"| namesp\d+:encodingStyle="http://schemas.xmlsoap.org/soap/encoding/"| xmlns:soapenc="http://schemas.xmlsoap.org/soap/encoding/"| xmlns:xsi="http://www.w3.o...
  $deserialized = SOAP::Deserializer->deserialize('<?xml version="1.0" encoding="UTF-8"?><soap:Envelope xmlns:soapenc="http://schemas.xmlsoap.org/soap/encoding/" soap:encodingStyle="http://schemas.xmlsoap.org/soap/encoding/" xmlns:xsi="http://www.w3....
  ok(! defined $deserialized->namespaceuriof('//getStateName'));

  $deserialized = SOAP::Deserializer->deserialize('<?xml version="1.0" encoding="UTF-8"?><soap:Envelope xmlns="a" xmlns:soapenc="http://schemas.xmlsoap.org/soap/encoding/" soap:encodingStyle="http://schemas.xmlsoap.org/soap/encoding/" xmlns:xsi="http...
  ok($deserialized->namespaceuriof('//getStateName') eq 'a');
}

{ # Map type serialization/deserialization
  print "Map type serialization/deserialization test(s)...\n";

  my $key = "\0\1";
  $serialized = SOAP::Serializer->method(aa => SOAP::Data->type(map => {a => 123, $key => 456})->name('maaap'));

  { local $^W; # disable warning on implicit map encoding
    my $implicit = SOAP::Serializer->method(aa => SOAP::Data->name(maaap => {a => 123, $key => 456}));
    ok($implicit eq $serialized);
  }
  ok($serialized =~ /apachens:Map/);
  ok($serialized =~ m!xmlns:apachens="http://xml.apache.org/xml-soap"!);

  $deserialized = SOAP::Deserializer->deserialize($serialized);
  $a = $deserialized->valueof('//maaap');
  ok(UNIVERSAL::isa($a => 'HASH'));
  ok(ref $a && $a->{$key} == 456);
}

{ # Stringified type serialization
  print "Stringified type serialization test(s)...\n";

  $serialized = SOAP::Serializer->serialize(bless { a => 1, _current => [] } => 'SOAP::SOM');

  my $test = $serialized;
  ok $test =~s{
            <\?xml \s version="1.0" \s encoding="UTF-8"\?>
            <SOAP__SOM
            (?:
                \sxsi:type="namesp(\d+):SOAP__SOM"
                | \sxmlns:namesp\d+="http://namespaces.soaplite.com/perl"
                | \sxmlns:soap="http://schemas.xmlsoap.org/soap/envelope/"
                | \sxmlns:soapenc="http://schemas.xmlsoap.org/soap/encoding/"
                | \sxmlns:xsi="http://www.w3.org/2001/XMLSchema-instance"
                | \sxmlns:xsd="http://www.w3.org/2001/XMLSchema"){6}>
  }{}xms;

  ok $test =~s{
      </SOAP__SOM> \z
  }{}xms;

  ok $test =~s{ <a \s xsi:type="xsd:int">1</a> }{}xms;
  ok $test =~s{ <_current (:?
        \s soapenc:arrayType="xsd:anyType\[0\]"
        | \s xsi:type="soapenc:Array" ){2}
       \s/>
    }{}xms;

  ok length $test == 0;

  # Replaced complex regex by several simpler (see above).

  # ok($serialized =~ m!<SOAP__SOM(?: xsi:type="namesp(\d+):SOAP__SOM"| xmlns:namesp\d+="http://namespaces.soaplite.com/perl"| xmlns:soap="http://schemas.xmlsoap.org/soap/envelope/"| xmlns:soapenc="http://schemas.xmlsoap.org/soap/encoding/"| xmlns:xs...
  # ok( ($serialized =~ m!<SOAP__SOM(?: xsi:type="namesp(\d+):SOAP__SOM"| xmlns:namesp\d+="http://namespaces.soaplite.com/perl"| xmlns:soap="http://schemas.xmlsoap.org/soap/envelope/"| xmlns:soapenc="http://schemas.xmlsoap.org/soap/encoding/"| xmlns:...
  # ||  ($serialized =~ m!<SOAP__SOM(?: xsi:type="namesp(\d+):SOAP__SOM"| xmlns:namesp\d+="http://namespaces.soaplite.com/perl"| xmlns:soap="http://schemas.xmlsoap.org/soap/envelope/"| xmlns:soapenc="http://schemas.xmlsoap.org/soap/encoding/"| xmlns:...
  #print $serialized;
  #  exit;

  $serialized =~ s/__/./g; # check for SOAP.SOM instead of SOAP__SOM
  ok(ref SOAP::Deserializer->deserialize($serialized)->root eq 'SOAP::SOM');
}

{ # Serialization of non-allowed element
  print "Serialization of non-allowed element test(s)...\n";

  eval { $serialized = SOAP::Serializer->serialize(SOAP::Data->name('---' => 'aaa')) };

  ok($@ =~ /^Element/);
}

{ # Custom serialization of blessed reference
  print "Custom serialization of blessed reference test(s)...\n";

  eval q!
    sub SOAP::Serializer::as_My__Own__Class {
      my $self = shift;
      my($value, $name, $type, $attr) = @_;
      return [$name, {%{$attr || {}}, 'xsi:type' => 'xsd:string'}, join ', ', map {"$_ => $value->{$_}"} sort keys %$value];
    }
    1;
  ! or die;

  $serialized = SOAP::Serializer->serialize(bless {a => 1, b => 2} => 'My::Own::Class');
  ok($serialized =~ m!<My__Own__Class( xsi:type="xsd:string"| xmlns:soap="http://schemas.xmlsoap.org/soap/envelope/"| xmlns:soapenc="http://schemas.xmlsoap.org/soap/encoding/"| xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance"| xmlns:xsd="http://...
}

{ # Multirefs serialization

t/02-payload.t  view on Meta::CPAN

  $a = { a => 'true' };
  $serialized = SOAP::Serializer->namespaces({})->serialize($a);

  ### 'false' evaluated as a boolean should still be false after the evaluation.
  ok($serialized =~ m!<c-gensym(\d+)><a xsi:type="xsd:boolean">true</a></c-gensym\1>!);

}
{
  print "Serialization with explicit namespaces test(s)...\n";

  $serialized = SOAP::Serializer->serialize(SOAP::Data->name('b' => 1));
  ok($serialized =~ m!<b !);

  $serialized = SOAP::Serializer->serialize(SOAP::Data->name('c:b' => 1));
  ok($serialized =~ m!<c:b !);

  $serialized = SOAP::Serializer->serialize(SOAP::Data->name('{a}b' => 1));
  ok($serialized =~ m!<namesp\d+:b ! && $serialized =~ m!xmlns:namesp\d+="a"!);

  $serialized = SOAP::Serializer->serialize(SOAP::Data->name('{}b' => 1));
  ok($serialized =~ m!<b ! && $serialized =~ m!xmlns=""!);

  my @prefix_uri_tests = (
    # prefix,   uri,  test
    [ undef,  undef,  '<b>1</b>' ],
    [ undef,     '',  '<b xmlns="">1</b>' ],
    [ undef,    'a',  '<(namesp\d+):b xmlns:\1="a">1</\1:b>' ],
    [    '',  undef,  '<b>1</b>' ],
    [    '',     '',  '<b xmlns="">1</b>' ],
    [    '',    'a',  '<b xmlns="a">1</b>' ],
    [   'c',  undef,  '<c:b>1</c:b>' ],
    [   'c',     '',  '<b xmlns="">1</b>' ],
    [   'c',    'a',  '<c:b xmlns:c="a">1</c:b>' ],
  );

  my $serializer = SOAP::Serializer->autotype(0)->namespaces({});
  my $deserializer = SOAP::Deserializer->new;
  my $testnum = 0;
  foreach (@prefix_uri_tests) {
    $testnum++;
    my($prefix, $uri, $test) = @$_;
    my $res = $serializer->serialize(
      SOAP::Data->name('b')->prefix($prefix)->uri($uri)->value(1)
    );
    ok($res =~ /$test/);
    next unless $testnum =~ /^([4569])$/;

    my $data = $deserializer->deserialize($res)->dataof(SOAP::SOM::root);
    ok(defined $prefix ? defined $data->prefix && $data->prefix eq $prefix
                       : !defined $data->prefix);
    ok(defined $uri ? defined $data->uri && $data->uri eq $uri
                    : !defined $data->uri);
  }
}

{
  print "Deserialization for different SOAP versions test(s)...\n";

  my $version = SOAP::Lite->soapversion;

  $a = q!<?xml version="1.0" encoding="UTF-8"?>
<soap:Envelope
  xmlns:soapenc="http://www.w3.org/2003/05/soap-encoding"
  soap:encodingStyle="http://www.w3.org/2003/05/soap-encoding"
  xmlns:soap="http://www.w3.org/2003/05/soap-envelope"
  xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance"
  xmlns:xsd="http://www.w3.org/2001/XMLSchema">
<soap:Body>
<namesp9:echoIntegerArray xmlns:namesp9="http://soapinterop.org/">
<inputIntegerArray soapenc:arrayType="xsd:int[3]" xsi:type="soapenc:Array">
<item xsi:type="xsd:int">1</item>
<item xsi:type="xsd:int">3</item>
<item xsi:type="xsd:int">5</item>
</inputIntegerArray>
</namesp9:echoIntegerArray>
</soap:Body>
</soap:Envelope>!;

  SOAP::Lite->soapversion(1.1);
  $deserialized = SOAP::Deserializer->deserialize($a);
  ok(ref $deserialized->result eq 'ARRAY');

  SOAP::Lite->soapversion(1.2);
  $deserialized = SOAP::Deserializer->deserialize($a);
  ok(ref $deserialized->result eq 'ARRAY');

  SOAP::Lite->soapversion($version);
}

{
  print "Deserialization of multidimensional array of array test(s)...\n";

  $a = q!<?xml version="1.0" encoding="UTF-8"?>
<S:Envelope S:encodingStyle='http://schemas.xmlsoap.org/soap/encoding/'
   xmlns:S='http://schemas.xmlsoap.org/soap/envelope/'
   xmlns:E='http://schemas.xmlsoap.org/soap/encoding/'
   xmlns:a='http://foo.bar.org/'
   xmlns:b='http://www.w3.org/2001/XMLSchema'
   xmlns:c='http://www.w3.org/2001/XMLSchema-instance'>
<S:Body><a:SomeMethod>
<nums E:arrayType='b:anyType[2,2]'>
<i E:arrayType='b:anyType[3]'>
<i c:type='b:short'>1</i><i c:type='b:short'>2</i><i c:type='b:short'>3</i>
</i>
<i E:arrayType='b:anyType[3]'>
<i c:type='b:short'>4</i><i c:type='b:short'>5</i><i c:type='b:short'>6</i>
</i>
<i E:arrayType='b:anyType[3]'>
<i c:type='b:short'>7</i><i c:type='b:short'>8</i><i c:type='b:short'>9</i>
</i>
<i E:arrayType='b:anyType[3]'>
<i c:type='b:short'>10</i><i c:type='b:short'>11</i><i c:type='b:short'>12</i>
</i>
</nums></a:SomeMethod></S:Body></S:Envelope>!;

  $deserialized = SOAP::Deserializer->deserialize($a)->result;

  # [
  #   [
  #     ['1', '2', '3'],
  #     ['4', '5', '6']
  #   ],
  #   [
  #     ['7', '8', '9'],
  #     ['10', '11', '12']
  #   ]
  # ]

  ok(ref $deserialized eq 'ARRAY');
  ok(@$deserialized == 2);
  ok(@{$deserialized->[0]} == 2);
  ok(@{$deserialized->[0]->[0]} == 3);
  ok($deserialized->[0]->[0]->[2] == 3);
}

{
  print "Serialization without specified typemapping test(s)...\n";

  $serialized = SOAP::Serializer->method(a => bless {a => 1} => 'A');
  ok($serialized =~ m!<A xsi:type="namesp\d+:A">!);
  ok($serialized =~ m!^<\?xml!); # xml declaration

  # higly questionably, but that's how it is
  $serialized = SOAP::Serializer->encoding(undef)->method(a => bless {a => 1} => 'A');
  ok($serialized =~ m!<A(?: xsi:type="namesp\d+:A"| xmlns:namesp\d+="http://namespaces.soaplite.com/perl")>!);
  ok($serialized !~ m!^<\?xml!); # no xml declaration
}

{
  print "Deserialization with different XML Schemas on one element test(s)...\n";

  my $deserializer = SOAP::Deserializer->new;
  $deserializer->deserialize(q!<soap:Envelope



( run in 0.412 second using v1.01-cache-2.11-cpan-1dc43b0fbd2 )