The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
[% USE XSD;
server_name = XSD.create_server_name(service, port);
-%]
package [% server_name %];
use strict;
use warnings;
use Class::Std::Fast::Storable;
use Scalar::Util qw(blessed);
use base qw(SOAP::WSDL::Client::Base);

[% IF USE_TYPEMAP -%]
# only load if it hasn't been loaded before
require [% XSD.create_typemap_name(service) %]
    if not [% XSD.create_typemap_name(service) %]->can('get_class');
[% END -%]

my %transport_class_of :ATTR(:name<transport_class> :default<SOAP::WSDL::Server::CGI>);
my %transport_of :ATTR(:name<transport> :default<()>);
my %dispatch_to :ATTR(:name<dispatch_to>);

my $action_map_ref = {
[%      binding = definitions.find_binding( port.expand( port.get_binding ) );
        FOREACH operation = binding.get_operation;
- %]
    '[% operation.first_operation.get_soapAction %]' => '[%  operation.get_name %]',
[% END %]
};

my $method_map_ref = {
[% FOREACH operation = binding.get_operation; - %]
    '[%  operation.get_name %]' => {
        operation => '[% operation.get_name %]',
        soap_action => '[% operation.first_operation.get_soapAction %]',
        style => [% style = operation.first_operation.get_style || binding.get_style;
            IF style != "document";
                THROW NOT_SUPPORTED "SOAP::WSDL supports document encoding only - $style found";
            END;
        -%]'[% style %]',
        body => {
            [% INCLUDE Interface/Body.tt( item = operation.first_input.first_body ); %]
        },
        header => {
            [% INCLUDE Interface/Header.tt( item = operation.first_input.get_header ); %]
        },
        headerfault => {
            [% INCLUDE Interface/Header.tt( item = operation.first_input.first_headerfault ); %]
        },
        response => {
            header => {
                [% INCLUDE Interface/Response/Header.tt( item = operation.first_output.first_header ); %]
            },
            body => {
                [% INCLUDE Interface/Response/Body.tt( item = operation.first_output.first_body ); %]
            },
        }
    },
[% END %]
};

sub START {
    my ($self, $ident, $arg_ref) = @_;
    eval "require $transport_class_of{ $ident }"
        or die "Cannot load transport class $transport_class_of{ $ident }: $@";
    $transport_of{ $ident } = $transport_class_of{ $ident }->new({
        action_map_ref => $action_map_ref,
        method_map_ref => $method_map_ref,
        class_resolver => '[% XSD.create_typemap_name(service) %]',
        dispatch_to => $dispatch_to{ $ident },
    });
}

sub handle {
    $transport_of{ ${ $_[0] } }->handle(@_[1..$#_]);
}

1;

[% IF NO_POD; STOP; END %]

__END__
[%# work around for CPAN's indexer, which gets disturbed by pod in templates -%]
[% pod = BLOCK %]=pod[% END -%]
[% head1 = BLOCK %]=head1[% END -%]
[% head2 = BLOCK %]=head2[% END -%]
[% head3 = BLOCK %]=head3[% END -%]

[% pod %]

[% head1 %] NAME

[% server_name %] - SOAP Server Class for the [% service.get_name %] Web Service

[% head1 %] SYNOPSIS

 use [% server_name %];
 my $server = [% server_name %]->new({
    dispatch_to => 'My::Handler::Class',
    transport_class => 'SOAP::WSDL::Server::CGI',   # optional, default
 });
 $server->handle();


[% head1 %] DESCRIPTION

SOAP Server handler for the [% service.get_name %] web service
located at [% port.first_address.get_location %].

[% head1 %] SERVICE [% service.get_name %]

[% service.get_documentation %]

[% head2 %] Port [% port.get_name %]

[% port.get_documentation %]

[% head1 %] METHODS

[% head2 %] General methods

[% head3 %] new

Constructor.

The C<dispatch_to> argument is mandatory. It must be a class or object
implementing the SOAP Service methods listed below.

[% head2 %] SOAP Service methods

[% INCLUDE Server/POD/method_info.tt %]

[%      FOREACH operation = binding.get_operation;
%][% INCLUDE Server/POD/Operation.tt %]
[%      END %]

[% head1 %] AUTHOR

Generated by SOAP::WSDL on [% PERL %]print scalar localtime() [% END %]

=cut