line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package SOAP::WSDL::Deserializer::XSD; |
2
|
3
|
|
|
3
|
|
12145
|
use strict; |
|
3
|
|
|
|
|
3
|
|
|
3
|
|
|
|
|
75
|
|
3
|
3
|
|
|
3
|
|
8
|
use warnings; |
|
3
|
|
|
|
|
2
|
|
|
3
|
|
|
|
|
55
|
|
4
|
3
|
|
|
3
|
|
820
|
use Class::Std::Fast::Storable; |
|
3
|
|
|
|
|
30040
|
|
|
3
|
|
|
|
|
14
|
|
5
|
3
|
|
|
3
|
|
1200
|
use SOAP::WSDL::SOAP::Typelib::Fault11; |
|
3
|
|
|
|
|
6
|
|
|
3
|
|
|
|
|
71
|
|
6
|
3
|
|
|
3
|
|
1067
|
use SOAP::WSDL::Expat::MessageParser; |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
7
|
|
|
|
|
|
|
|
8
|
|
|
|
|
|
|
our $VERSION = 3.003; |
9
|
|
|
|
|
|
|
|
10
|
|
|
|
|
|
|
my %class_resolver_of :ATTR(:name :default<()>); |
11
|
|
|
|
|
|
|
my %strict_of :ATTR(:get :init_arg :default<1>); |
12
|
|
|
|
|
|
|
my %parser_of :ATTR(); |
13
|
|
|
|
|
|
|
|
14
|
|
|
|
|
|
|
sub set_strict { |
15
|
|
|
|
|
|
|
undef $parser_of{${$_[0]}}; |
16
|
|
|
|
|
|
|
$strict_of{${$_[0]}} = $_[1]; |
17
|
|
|
|
|
|
|
} |
18
|
|
|
|
|
|
|
|
19
|
|
|
|
|
|
|
sub BUILD { |
20
|
|
|
|
|
|
|
my ($self, $ident, $args_of_ref) = @_; |
21
|
|
|
|
|
|
|
|
22
|
|
|
|
|
|
|
# ignore all options except 'class_resolver' |
23
|
|
|
|
|
|
|
for (keys %{ $args_of_ref }) { |
24
|
|
|
|
|
|
|
next if $_ eq 'strict'; |
25
|
|
|
|
|
|
|
next if $_ eq 'class_resolver'; |
26
|
|
|
|
|
|
|
delete $args_of_ref->{ $_ }; |
27
|
|
|
|
|
|
|
} |
28
|
|
|
|
|
|
|
} |
29
|
|
|
|
|
|
|
|
30
|
|
|
|
|
|
|
sub deserialize { |
31
|
|
|
|
|
|
|
my ($self, $content) = @_; |
32
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
$parser_of{ ${ $self } } = SOAP::WSDL::Expat::MessageParser->new({ |
34
|
|
|
|
|
|
|
strict => $strict_of{ ${ $self } } |
35
|
|
|
|
|
|
|
}) |
36
|
|
|
|
|
|
|
if not $parser_of{ ${ $self } }; |
37
|
|
|
|
|
|
|
$parser_of{ ${ $self } }->class_resolver( $class_resolver_of{ ${ $self } } ); |
38
|
|
|
|
|
|
|
$content =~ s{^<\?xml version="1.0" *\?>}{}; # XML::Parser::Expat apparently doesn't like this. |
39
|
|
|
|
|
|
|
eval { $parser_of{ ${ $self } }->parse_string( $content ) }; |
40
|
|
|
|
|
|
|
if ($@) { |
41
|
|
|
|
|
|
|
return $self->generate_fault({ |
42
|
|
|
|
|
|
|
code => 'SOAP-ENV:Server', |
43
|
|
|
|
|
|
|
role => 'urn:localhost', |
44
|
|
|
|
|
|
|
message => "Error deserializing message: $@. \n" |
45
|
|
|
|
|
|
|
. "Message was: \n$content" |
46
|
|
|
|
|
|
|
}); |
47
|
|
|
|
|
|
|
} |
48
|
|
|
|
|
|
|
return ( $parser_of{ ${ $self } }->get_data(), $parser_of{ ${ $self } }->get_header() ); |
49
|
|
|
|
|
|
|
} |
50
|
|
|
|
|
|
|
|
51
|
|
|
|
|
|
|
sub generate_fault { |
52
|
|
|
|
|
|
|
my ($self, $args_from_ref) = @_; |
53
|
|
|
|
|
|
|
return SOAP::WSDL::SOAP::Typelib::Fault11->new({ |
54
|
|
|
|
|
|
|
faultcode => $args_from_ref->{ code } || 'SOAP-ENV:Client', |
55
|
|
|
|
|
|
|
faultactor => $args_from_ref->{ role } || 'urn:localhost', |
56
|
|
|
|
|
|
|
faultstring => $args_from_ref->{ message } || "Unknown error" |
57
|
|
|
|
|
|
|
}); |
58
|
|
|
|
|
|
|
} |
59
|
|
|
|
|
|
|
|
60
|
|
|
|
|
|
|
1; |
61
|
|
|
|
|
|
|
|
62
|
|
|
|
|
|
|
__END__ |