SOAP Daemon memory leak

[Mike Gent]

I have an application that runs as a stand-alone daemon returning SOAP
results. It's been running fine for a long time, but I recently noticed
the memory growing and not being released after every connection.

I've created a custom module based on the code of
SOAP::Transport::HTTP::Daemon, but supporting spawning threads when a
connection is accepted.

Running ActivePerl 5.8.8.822 with threads 1.6.3 and threads::shared 1.12
under CentOS Linux.

Here's a sample application that can be used to reproduce the problem.

SOAPServer.pl:
--------------
#!perl

use strict;
use threads ('stack_size' => 32*4096, 'exit' => 'threads_only');
use SOAPDaemon;

sub Start {
        my $SOAPServerThread = threads->new(sub {
                my $SOAPServer = SOAPDaemon->new(
                        LocalPort       => 10000,
                        ReuseAddr       => 1
                )->dispatch_to('main');
                
                $SOAPServer->Handle;
        });
}

sub Ping {
        my $Self = shift;
        
        return {Valid => 1, Output => 'Pong'};
}

Start();

while(1) {
        sleep(1);
}

SOAPDaemon.pm:
--------------
#!perl
package SOAPDaemon;

# Custom package derived from SOAP::Transport::HTTP::Daemon

use Data::Dumper;
use Carp ();
use HTTP::Daemon;
use SOAP::Transport::HTTP;

use vars qw($AUTOLOAD @ISA);
@ISA = qw(SOAP::Transport::HTTP::Server);

sub DESTROY { SOAP::Trace::objects('()') }

sub new {
        my $self = shift;
        
        unless (ref $self) {
                my $class = ref($self) || $self;
                
                my(@params, @methods);
                while (@_) { $class->can($_[0]) ? push(@methods, shift()
=> shift) : push(@params, shift) }
                $self = $class->SUPER::new;
                
                $self->{_daemon} = HTTP::Daemon->new(@params) or
Carp::croak "Can't create daemon: $!";
                
        
$self->myuri(URI->new($self->url)->canonical->as_string);
                while (@methods) {
                        my($method, $params) = splice(@methods,0,2);
                        $self->$method(ref $params eq 'ARRAY' ? @$params
: $params) 
                }
                SOAP::Trace::objects('()');
        }
        
        return $self;
}

sub AUTOLOAD {
        my $method = substr($AUTOLOAD, rindex($AUTOLOAD, '::') + 2);
        return if $method eq 'DESTROY';
        
        no strict 'refs';
        *$AUTOLOAD = sub { shift->{_daemon}->$method(@_) };
        goto &$AUTOLOAD;
}

sub Handle {
        my $self = shift->new;
        
        while (my $c = $self->accept) {
                threads->new(\&SOAPWorker, $self, $c);
        }
}

sub SOAPWorker {
        my $Obj = shift;
        my $c   = shift;
        
        while (my $r = $c->get_request(0)) {
                $Obj->request($r);
                $Obj->SUPER::handle;
                $c->send_response($Obj->response);
        }
        
        # replaced ->close, thanks to Sean Meisner
<[EMAIL PROTECTED]>
        # shutdown() doesn't work on AIX. close() is used in this case.
Thanks to Jos Clijmans <[EMAIL PROTECTED]>
        UNIVERSAL::isa($c, 'shutdown') ? $c->shutdown(2) : $c->close(); 
        $c->close;
        
        threads->self()->detach();
}

# Always end package with true
1;

__END__