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