1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
|
package MyTypemap;
sub get_typemap { return {} }
package main;
use Test::More;
use CGI;
plan tests => 8;
use_ok(SOAP::WSDL::Server);
use_ok(SOAP::WSDL::Server::Simple);
my $server = SOAP::WSDL::Server::Simple->new( {class_resolver => 'MyTypemap',} );
$server->set_action_map_ref( {'testaction' => 'testmethod',} );
test_fault_output();
test_deserializer_fault();
test_simple_fault();
test_success();
#
# test _output by forcing a fault (passing a empty CGI object)
# IO::Scalar required
#
sub test_fault_output {
no warnings qw(once);
SKIP: {
eval "require IO::Scalar"
or skip 'IO::Scalar required for testing...', 1;
# set up a IO::Scalar handle as STDOUT
local *IO::Scalar::BINMODE = sub { };
my $output = q{};
my $fh = IO::Scalar->new( \$output );
{
local *STDOUT = $fh;
# don't try to print() anything from here on - it gehts caught in $output,
#and does not make it to STDOUT...
$server->handle( CGI->new() );
}
like $output, qr{no \s element \s found}xms;
}
}
sub test_deserializer_fault {
*SOAP::WSDL::Server::Simple::_output = sub {
like $_[1]->content(), qr{Error \s deserializing \s message}xms,
'Fault on (wrong) content';
};
local $ENV{REQUEST_METHOD} = 'POST';
local $ENV{HTTP_SOAPACTION} = 'testaction';
$server->handle(
CGI->new( {
POSTDATA => q{<SOAP-ENV:Envelope
xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance"
xmlns:SOAP-ENV="http://schemas.xmlsoap.org/soap/envelope/"
><SOAP-ENV:Body>
<TestOperation xmlns="http://www.example.org/example/">
<Name>Kutter</Name>
<Vorname>Martin</Vorname>
<Anrede>Herr</Anrede>
</TestOperation>
</SOAP-ENV:Body>
</SOAP-ENV:Envelope>}
} ) );
}
sub test_simple_fault {
*SOAP::WSDL::Server::Simple::_output = sub {
is $_[1]->code, 500;
like $_[1]->content(), qr{Something \s is \s rotten}xms,
'Fault on (wrong) content';
};
local $ENV{REQUEST_METHOD} = 'POST';
local $ENV{HTTP_SOAPAction} = 'testaction';
local *SOAP::WSDL::Server::handle = sub { die 'Something is rotten' };
$server->handle(
CGI->new( {
POSTDATA => q{<SOAP-ENV:Envelope
xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance"
xmlns:SOAP-ENV="http://schemas.xmlsoap.org/soap/envelope/"
><SOAP-ENV:Body>
<TestOperation xmlns="http://www.example.org/example/">
<Name>Kutter</Name>
<Vorname>Martin</Vorname>
<Anrede>Herr</Anrede>
</TestOperation>
</SOAP-ENV:Body>
</SOAP-ENV:Envelope>}
} ) );
}
sub test_success {
*SOAP::WSDL::Server::Simple::_output = sub {
is $_[1]->code(), 200;
like $_[1]->content(), qr{Everything \s OK}xms,
'Status 200 on OK content';
};
local $ENV{REQUEST_METHOD} = 'POST';
local $ENV{HTTP_SOAPAction} = 'testaction';
local *SOAP::WSDL::Server::handle = sub { 'Everything OK' };
$server->handle(
CGI->new( {
POSTDATA => q{<SOAP-ENV:Envelope
xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance"
xmlns:SOAP-ENV="http://schemas.xmlsoap.org/soap/envelope/"
><SOAP-ENV:Body>
<TestOperation xmlns="http://www.example.org/example/">
<Name>Kutter</Name>
<Vorname>Martin</Vorname>
<Anrede>Herr</Anrede>
</TestOperation>
</SOAP-ENV:Body>
</SOAP-ENV:Envelope>}
} ) );
}
|
