| Subject: | Serialization / Deserialization of blessed scalar-refs could be improved. |
I've noticed that if you try to serialize/deserialize a blessed reference to a scalar in SOAP::Lite, you end up with a blessed hashref when you are done.
Consider the following minimal test case:
---------------------------------------------------
#!/usr/bin/perl
use strict;
use Test::More tests => 3;
use SOAP::Transport::HTTP;
use SOAP::Lite;
use Data::Dumper;
use constant PORT => 9001;
unless( fork() ) {
my $daemon = SOAP::Transport::HTTP::Daemon
->new( LocalAddr => localhost => LocalPort => &PORT )
->dispatch_to('Foo')
->handle;
}
diag "Server side:\n";
my $sside = Foo->create_foo;
isa_ok( $sside, 'SCALAR', 'Server side Foo' );
diag Dumper( $sside );
$sside->foo;
diag Dumper( $sside );
my $client = SOAP::Lite->new
->proxy( 'http://localhost:' . PORT )
->uri ( 'http://localhost/Foo' );
diag "Client side:\n";
my $cside = $client->create_foo()->result;
isa_ok( $cside, 'SCALAR', 'Client side Foo' );
diag 'Should be a blessed scalar reference';
diag Dumper($cside);
my $result = $client->foo($cside);
ok( ! $result->fault, 'Should not fault when calling foo()' );
if ( $result->fault ) {
diag "Fault string: ", $result->faultstring;
}
package Foo;
sub create_foo {
my $t = 12345;
bless \$t;
}
sub foo {
my $self = shift;
$$self++;
}
__END__
It turns out that there is a solution to this problem, and that's to write an as_Foo method in the Deserializer and then install it on the server and all the clients:
sub SOAP::Deserializer::as_Foo {
my ($self, $value, $name, $attrs, $children, $type) = @_;
$name =~ s/__/::/g;
my (undef, $value ) = $self->decode_object( $children->[0] );
return bless \$value, $name;
}
However, this seems sort of hack-ish. I think that the deserialization can be improved so that this is no longer necessary. If I understand correctly, I think the place where this is all happening is here in decode_value:
1977 } elsif ($name =~ /^\{$SOAP::Constants::NS_ENC\}Struct$/ || !$schemaclass->can($method) && (ref $children || defined $class && $value =~ /^\s*$/)) {
1978 my $res = {};
1979 $self->hrefs->{$id} = $res if defined $id;
1980 %$res = map {$self->decode_object($_)} @{$children || []};
1981 return defined $class && $class ne 'SOAPStruct' ? bless($res => $class) : $res;
Line 1980 is assuming that all objects are blessed hashes, which is incorrect. Is there something that could be done here to try to find out if the object is a blessed SCALAR?
I note that SOAP::Serializer has a sub gen_name that guarantees all un-named will be given a name matching /c-gensym\d+/. Would it make sense that if the variable was un-named going into the serializer, it should be unnamed coming out of the deserializer as well?
An alternate solution would be to add a 'SOAP-ENC:scalarType' to the variable attributes in the serializer and de-serializer to identify blessed scalars.
#!/usr/bin/perl
use strict;
use Test::More tests => 3;
use SOAP::Transport::HTTP;
use SOAP::Lite;
use Data::Dumper;
use constant PORT => 9001;
unless( fork() ) {
my $daemon = SOAP::Transport::HTTP::Daemon
->new( LocalAddr => localhost => LocalPort => &PORT )
->dispatch_to('Foo')
->handle;
}
diag "Server side:\n";
my $sside = Foo->create_foo;
isa_ok( $sside, 'SCALAR', 'Server side Foo' );
diag Dumper( $sside );
$sside->foo;
diag Dumper( $sside );
my $client = SOAP::Lite->new
->proxy( 'http://localhost:' . PORT )
->uri ( 'http://localhost/Foo' );
diag "Client side:\n";
my $cside = $client->create_foo()->result;
isa_ok( $cside, 'SCALAR', 'Client side Foo' );
diag 'Should be a blessed scalar reference';
diag Dumper($cside);
my $result = $client->foo($cside);
ok( ! $result->fault, 'Should not fault when calling foo()' );
if ( $result->fault ) {
diag "Fault string: ", $result->faultstring;
}
package Foo;
sub create_foo {
my $t = 12345;
bless \$t;
}
sub foo {
my $self = shift;
$$self++;
}