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
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
|
package SOAP::WSDL::Server::Simple;
use strict;
use warnings;
use Encode;
use HTTP::Request;
use HTTP::Response;
use HTTP::Status;
use HTTP::Headers;
use Scalar::Util qw(blessed);
use Class::Std::Fast::Storable;
use base qw(SOAP::WSDL::Server);
our $VERSION = 3.004;
# mostly copied from SOAP::Lite. Unfortunately we can't use SOAP::Lite's CGI
# server directly - we would have to swap out it's base class...
#
# This should be a warning for us: We should not handle methods via inheritance,
# but via some plugin mechanism, to allow alternative handlers to be plugged
# in.
sub handle {
my ($self, $cgi) = @_;
my $response;
my $content = $cgi->param('POSTDATA');
my $request = HTTP::Request->new(
$ENV{'REQUEST_METHOD'} || '' => $ENV{'SCRIPT_NAME'},
HTTP::Headers->new(
map {
(/^HTTP_(.+)/i
? ($1=~m/SOAPACTION/)
?('SOAPAction')
:($1)
: $_
) => $ENV{$_}
} keys %ENV),
$content,
);
# we copy the response message around here.
# Passing by reference would be much better...
my $response_message = eval { $self->SUPER::handle($request) };
# caveat: SOAP::WSDL::SOAP::Typelib::Fault11 is false in bool context...
if ($@ || blessed $@) {
my $exception = $@;
$response = HTTP::Response->new(500);
$response->header('Content-type' => 'text/xml; charset="utf-8"');
if (blessed($exception)) {
$response->content( $self->get_serializer->serialize({
body => $exception
})
);
}
else {
$response->content($exception);
}
}
else {
$response = HTTP::Response->new(200);
$response->header('Content-type' => 'text/xml; charset="utf-8"');
$response->content( encode('utf8', $response_message ) );
{
use bytes;
$response->header('Content-length', length $response_message);
}
}
$self->_output($response);
return;
}
sub _output :PRIVATE {
my ($self, $response) = @_;
my $code = $response->code;
binmode(STDOUT);
print STDOUT "HTTP/1.0 $code ", HTTP::Status::status_message($code)
, "\015\012", $response->headers_as_string("\015\012")
, "\015\012", $response->content;
warn "HTTP/1.0 $code ", HTTP::Status::status_message($code)
, "\015\012", $response->headers_as_string("\015\012")
, $response->content, "\n\n";
}
1;
=pod
=head1 NAME
SOAP::WSDL::Server::Simple - CGI based SOAP server for HTTP::Server::Simple
=head1 SYNOPSIS
package TestServer;
use base qw(HTTP::Server::Simple::CGI);
use MyServer::TestService::TestPort;
sub handle_request {
my ($self, $cgi) = @_;
my $server = MyServer::TestService::TestPort->new({
dispatch_to => 'main',
transport_class => 'SOAP::WSDL::Server::Simple',
});
$server->handle($cgi);
}
my $httpd = __PACKAGE__->new();
$httpd->run();
=head1 USAGE
To use SOAP::WSDL::Server::Simple efficiently, you should first create a server
interface using L<wsdl2perl.pl|wsdl2perl.pl>.
SOAP::WSDL::Server::Simple dispatches all calls to appropriately named methods in the
class or object set via C<dispatch_to>.
See the generated server class on details.
=head1 DESCRIPTION
Lightweight SOAP server for use with HTTP::Server::Simple, mainly designed
for testing purposes. It allows one to set up a simple SOAP server without having
to configure CGI or mod_perl stuff.
SOAP::WSDL::Server::Simple is not recommended for production use.
=head1 METHODS
=head2 handle
See synopsis above.
=head1 LICENSE AND COPYRIGHT
Copyright 2004-2008 Martin Kutter.
This file is part of SOAP-WSDL. You may distribute/modify it under the same
terms as perl itself
=head1 AUTHOR
Martin Kutter E<lt>martin.kutter fen-net.deE<gt>
=head1 REPOSITORY INFORMATION
$Rev: 391 $
$LastChangedBy: kutterma $
$Id: Client.pm 391 2007-11-17 21:56:13Z kutterma $
$HeadURL: https://soap-wsdl.svn.sourceforge.net/svnroot/soap-wsdl/SOAP-WSDL/trunk/lib/SOAP/WSDL/Client.pm $
=cut
|
