1package SOAP::WSDL::Server::Simple;
2use strict;
3use warnings;
4
5use Encode;
6
7use HTTP::Request;
8use HTTP::Response;
9use HTTP::Status;
10use HTTP::Headers;
11use Scalar::Util qw(blessed);
12
13use Class::Std::Fast::Storable;
14
15use base qw(SOAP::WSDL::Server);
16
17our $VERSION = 3.004;
18
19# mostly copied from SOAP::Lite. Unfortunately we can't use SOAP::Lite's CGI
20# server directly - we would have to swap out it's base class...
21#
22# This should be a warning for us: We should not handle methods via inheritance,
23# but via some plugin mechanism, to allow alternative handlers to be plugged
24# in.
25
26sub handle {
27    my ($self, $cgi) = @_;
28
29    my $response;
30
31    my $content = $cgi->param('POSTDATA');
32
33    my $request = HTTP::Request->new(
34        $ENV{'REQUEST_METHOD'} || '' => $ENV{'SCRIPT_NAME'},
35        HTTP::Headers->new(
36            map {
37                    (/^HTTP_(.+)/i
38                        ? ($1=~m/SOAPACTION/)
39                            ?('SOAPAction')
40                            :($1)
41                        : $_
42                     ) => $ENV{$_}
43            } keys %ENV),
44        $content,
45    );
46
47    # we copy the response message around here.
48    # Passing by reference would be much better...
49    my $response_message = eval { $self->SUPER::handle($request) };
50
51    # caveat: SOAP::WSDL::SOAP::Typelib::Fault11 is false in bool context...
52    if ($@ || blessed $@) {
53        my $exception = $@;
54        $response = HTTP::Response->new(500);
55        $response->header('Content-type' => 'text/xml; charset="utf-8"');
56        if (blessed($exception)) {
57            $response->content( $self->get_serializer->serialize({
58                    body => $exception
59                })
60            );
61        }
62        else {
63            $response->content($exception);
64        }
65    }
66    else {
67        $response = HTTP::Response->new(200);
68        $response->header('Content-type' => 'text/xml; charset="utf-8"');
69        $response->content( encode('utf8', $response_message ) );
70        {
71            use bytes;
72            $response->header('Content-length', length $response_message);
73        }
74    }
75
76    $self->_output($response);
77    return;
78}
79
80sub _output :PRIVATE {
81    my ($self, $response) = @_;
82    my $code = $response->code;
83    binmode(STDOUT);
84    print STDOUT "HTTP/1.0 $code ", HTTP::Status::status_message($code)
85        , "\015\012", $response->headers_as_string("\015\012")
86        , "\015\012", $response->content;
87
88    warn "HTTP/1.0 $code ", HTTP::Status::status_message($code)
89        , "\015\012", $response->headers_as_string("\015\012")
90        , $response->content, "\n\n";
91}
92
931;
94
95=pod
96
97=head1 NAME
98
99SOAP::WSDL::Server::Simple - CGI based SOAP server for HTTP::Server::Simple
100
101=head1 SYNOPSIS
102
103 package TestServer;
104 use base qw(HTTP::Server::Simple::CGI);
105 use MyServer::TestService::TestPort;
106
107 sub handle_request {
108     my ($self, $cgi) = @_;
109     my $server = MyServer::TestService::TestPort->new({
110         dispatch_to => 'main',
111         transport_class => 'SOAP::WSDL::Server::Simple',
112     });
113     $server->handle($cgi);
114 }
115
116 my $httpd = __PACKAGE__->new();
117 $httpd->run();
118
119=head1 USAGE
120
121To use SOAP::WSDL::Server::Simple efficiently, you should first create a server
122interface using L<wsdl2perl.pl|wsdl2perl.pl>.
123
124SOAP::WSDL::Server::Simple dispatches all calls to appropriately named methods in the
125class or object set via C<dispatch_to>.
126
127See the generated server class on details.
128
129=head1 DESCRIPTION
130
131Lightweight SOAP server for use with HTTP::Server::Simple, mainly designed
132for testing purposes. It allows one to set up a simple SOAP server without having
133to configure CGI or mod_perl stuff.
134
135SOAP::WSDL::Server::Simple is not recommended for production use.
136
137=head1 METHODS
138
139=head2 handle
140
141See synopsis above.
142
143=head1 LICENSE AND COPYRIGHT
144
145Copyright 2004-2008 Martin Kutter.
146
147This file is part of SOAP-WSDL. You may distribute/modify it under the same
148terms as perl itself
149
150=head1 AUTHOR
151
152Martin Kutter E<lt>martin.kutter fen-net.deE<gt>
153
154=head1 REPOSITORY INFORMATION
155
156 $Rev: 391 $
157 $LastChangedBy: kutterma $
158 $Id: Client.pm 391 2007-11-17 21:56:13Z kutterma $
159 $HeadURL: https://soap-wsdl.svn.sourceforge.net/svnroot/soap-wsdl/SOAP-WSDL/trunk/lib/SOAP/WSDL/Client.pm $
160
161=cut
162