Here is my solution of the task. It isn't very graceful. But it works:
package My::Net::SOAP::Transport::HTTP::Daemon;
use SOAP::Transport::HTTP;
use My::Net::SOAP::Transport::HTTP::Server;
@SOAP::Transport::HTTP::Daemon::ISA = qw(
My::Net::SOAP::Transport::HTTP::Server
);
@My::Net::SOAP::Transport::HTTP::Daemon::ISA = qw(
SOAP::Transport::HTTP::Daemon
);
sub setWsdl($$) {
my $self = shift;
my $wsdlUri = shift;
my $wsdlFile = shift;
$/ = undef;
open FILE, $wsdlFile or die "Cannot open '$wsdlFile' ($!)";
$My::Net::SOAP::Transport::HTTP::Server::WsdlFileContent = <FILE>;
close FILE;
$My::Net::SOAP::Transport::HTTP::Server::WsdlURI = $wsdlUri;
return 1;
}
1;
package My::Net::SOAP::Transport::HTTP::Server;
use strict;
use SOAP::Transport::HTTP;
our @ISA = qw(
SOAP::Transport::HTTP::Server
);
our $WsdlFileContent;
our $WsdlURI;
sub handle {
my $class = shift;
my $result;
eval {
my $self = $class->new;
if ($self->request->method eq 'GET') {
if( $self->request->uri eq $WsdlURI ) {
my $response = $WsdlFileContent;
print "FOO:\n";
$result = $self->make_response(undef,$response) || 1;
}
else {
print STDERR "Got GET request with wrong URI '".$self-
+>request->uri."'!='$WsdlURI', ignoring";
}
}
};
if( $@ ) {
print STDERR "Runtime error ($@)";
return undef;
}
return $result if $result;
return $class->handle();
}
1;
# now use derived Daemon class regular way
use My::Net::SOAP::Transport::HTTP::Daemon;
my $daemon = My::Net::SOAP::Transport::HTTP::Daemon->new(
LocalAddr => 'myhostname',
LocalPort => 9999,
)
or die "Cannot create My::Net::SOAP::Transport::HTTP::Daemon";
$daemon->setWsdl("/$service?WSDL",'/path/to/file.wsdl')
or die "Cannot set WSDL ($@)";
my $dispatcher = $daemon->dispatch_with({ 'urn:/'.$service => 'My::WS:
+:'.$service });
my $object = $dispatcher->objects_by_reference("My::WS::".$service);
$object->dispatch_to('/my/lib/My/WS', $service);
$object->handle;
|