package SOAP::WSDL::Server::Plack::Transport;
use Moose;
# ABSTRACT: Plack Server Transport for SOAP::WSDL
use Carp;
use Try::Tiny;
# As SOAP::WSDL::Server is a Class::Std::Fast inside-out class we can't
# reliable inherit from it without using Class::Std::Fast too. Instead
# of inheritance we use a delegate pattern
use SOAP::WSDL::Server;
has 'action_map_ref' => (
is => 'rw',
isa => 'HashRef',
);
has 'class_resolver' => (
is => 'rw',
isa => 'Str',
);
has 'dispatch_to' => (
is => 'rw',
isa => 'Str',
);
# private server instance for delegate
has '_soap_wsdl_server' => (
is => 'ro',
isa => 'SOAP::WSDL::Server',
lazy => 1,
default => sub {
my $self = $_[0];
return SOAP::WSDL::Server->new({
action_map_ref => $self->action_map_ref(),
class_resolver => $self->class_resolver(),
dispatch_to => $self->dispatch_to(),
});
},
handles => [qw(
get_action_map_ref
set_action_map_ref
get_class_resolver
set_class_resolver
get_dispatch_to
set_dispatch_to
)],
documentation => 'Carry SOAP::WSDL::Server instance to delegate to',
);
sub handle {
my ($self, $req) = @_;
my $logger = $req->logger();
$logger = sub { } unless defined $logger;
my $length = $req->headers->header('Content-Length');
if (!$length) {
$logger->({
level => 'error',
message => "No Content-Length provided",
});
# TODO maybe throw instead of returning a HTTP code?
return 411; # Length required
}
# read may return less than requested - read until there's no more...
my ($buffer, $read_length);
my $body_psgi_input = $req->body();
my $content = q{};
while ($read_length = $body_psgi_input->read($buffer, $length)) {
$content .= $buffer;
}
if ($length != length($content)) {
$logger->({
level => 'error',
message => sprintf(
"Read length mismatch; read [%d] bytes but received [%d] bytes",
length($content), $length
),
});
return 500;
}
# Shamelessly copied (with mild tweaks) from SOAP::WSDL::Server::Mod_Perl2
# which was as shamelessly copied from SOAP::WSDL::Server::CGI which was
# as shamelessly copied from SOAP::Transport::HTTP...
my $request = HTTP::Request->new(
$req->method() => $req->uri(),
$req->headers->clone(),
$content
);
#HTTP::Headers->new( SOAPAction => $req->headers->header('SOAPAction') ),
my $response_message;
try {
#$response_message = $self->SUPER::handle($request);
$response_message = $self->_soap_wsdl_server->handle($request);
} catch {
my $exception = $_;
$logger->({
level => 'error',
message => "Failed to handle request: $exception",
});
return 500;
};
return $response_message;
};
__PACKAGE__->meta->make_immutable();
__END__
=pod
=head1 NAME
SOAP::WSDL::Server::Plack::Transport - Plack Server Transport for SOAP::WSDL
=head1 VERSION
version 0.006
=head1 DESCRIPTION
Transport class for L<SOAP::WSDL::Server::Plack>. Don't use it
directly.
=head1 ATTRIBUTES
=over
=item action_map_ref
Action map parameter forwarded to L<SOAP::WSDL::Server>
=item class_resolver
Class resolver parameter forwarded to L<SOAP::WSDL::Server>
=item dispatch_to
Dispatch to parameter forwarded to L<SOAP::WSDL::Server>
=back
=head1 METHODS
=head2 handle
In case no transport class is defined this method is called by the
by the Plack server handler to dispatch to the SOAP server interface.
=head1 SEE ALSO
L<SOAP::WSDL::Server::Plack> - Server adaptor
=head1 AUTHOR
Andreas Stricker <andy@knitter.ch>
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2013 by futureLAB AG, info@futurelab.ch.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut