web service using perl, wsdl and multi-threading does not working

Question

web service using perl, wsdl and multi-threading not working:

1. Command line execution with threading: works
2. Soap client call with threading: doesn't work
3. Soap client call without threading: works

Here i am trying to update thousands of sieve file using threading, but it does not work, if i use threading. I am trying to make web service fast using perl, currently it is written in php, but threading with web service not working any help would be helpful.

It return following error when i call web service from soap client(soap_client.pl).

500 Server closed connection without sending any data back

Installed perl modules:

MIME::Parser
SOAP::Lite

Apache module:

mod_perl

Apache virtual hosting:

<VirtualHost 192.168.1.187:80>
 ServerName sieve.net
 ServerAlias www.sieve.net
 DocumentRoot /web/sieve.net/htdocs
 ErrorLog /var/log/httpd/sieve.net_error_log
 TransferLog /var/log/httpd/sieve.net_access_log

 <Directory "/web/sieve.net/htdocs">
        <FilesMatch "\.mhtml$|\.pl$|\.html$">
                Options         +ExecCGI
                AddHandler      cgi-script .cgi .pl .html
                SetHandler      perl-script
                PerlHandler     ModPerl::Registry
                PerlSendHeader  On
        </FilesMatch>
      </Directory>
 DirectoryIndex index.phtml index.htm index.html index.pl
</VirtualHost>

sievefilter_thread.pl

#!/usr/bin/perl
use strict;
use SOAP::Lite;
use SOAP::Transport::HTTP;
use lib "/web/sieve.net/htdocs";
use Sieve;
use threads;
use Thread::Queue;

my $soap = SOAP::Transport::HTTP::CGI->new(
    dispatch_to => 'manageSieve'
);
$soap->handle();

package manageSieve;
sub updateSieveFilter {
    my ($package, $client_id) = @_;
    my @users = ({
                    'Password' => 'test',
                'Login' => 'test1@example.in'
                 },
             {
                    'Password' => 'test',
                'Login' => 'test2@example.in'
                 },
             {
                    'Password' => 'test',
                'Login' => 'test3@example.in'
                 },
             {
                    'Password' => 'test',
                'Login' => 'test4@example.in'
                 },         
             {
                    'Password' => 'test',
                'Login' => 'test5@example.in'
                 }, 
        );
    if(@users) {
        my $THREADS = 30;
                my $Qwork = new Thread::Queue;
                my $Qresults = new Thread::Queue;

                # If i return any value from here it wokrs. 
                ## Create the pool of workers
                my @pool = map{
                        threads->create( \&updateClientUsersSieve, $Qwork, $Qresults )
                } 1 .. $THREADS;

                # Does not return any value from here.

                foreach my $user (@users){
                        $Qwork->enqueue( $user );
                        if( $counter % 100 == 0){
                                sleep 1;
                        }
                        $counter++;
                }
                $Qwork->enqueue( (undef) x $THREADS );
        ## Process the results as they become available
                for ( 1 .. $THREADS ) {
                        while( $result = $Qresults->dequeue ) {
                                #print $result;
                        }
                }
                # Clean up the threads          
                $_->join for @pool;
                return 1;
        }
        return 0;   
}

sub updateClientUsersSieve {
        my $tid = threads->tid;
        my $result = 1;
        my( $Qwork, $Qresults ) = @_;
        my ($login, $password);
        while( my $user = $Qwork->dequeue ) {
                ($login, $password) = ($user->{'Login'}, $user->{'Password'});

                my $sieveObj    = new Sieve($login, $password);
                $result   = $sieveObj->sieveLogin();
                $Qresults->enqueue( $result );
        }
        $Qresults->enqueue( undef ); ## Signal this thread is finished
}
1;

Sieve.pm

#!/usr/bin/perl
package Sieve;
use Net::ManageSieve;
use strict;

sub new {
   my $class = shift;
   my $self = {
        _username => shift,
        _password => shift,
        _sieve    => undef,
   };
   bless $self, $class;
   return $self;
}

sub sieveLogin {
    my ($self)  = @_;
    my $sieveServer     = 'localhost';
    my $sievePort       = 2000;
    my $authType        = 'PLAIN';
    my $username        = $self->{_username};
    my $password        = $self->{_password};
    my $capabilities    = "require [";
    my $activescript    = "";
    my $script_name     = "sievephp_testscript";
    my $error           = undef;

    $self->{_sieve}  = Net::ManageSieve->new("$sieveServer:$sievePort");
    if(!$self->{_sieve}->login($username, $password)){
    return 0;
    }

    $capabilities = $self->{_sieve}->capabilities->{sieve};
    $capabilities =~ s/\s/\",\"/g;
    $capabilities = 'require ["'.$capabilities.'"];'."\n";
    $activescript = $capabilities;
    $activescript .= "\n";
    $activescript .= "if allof (size :over 1000K ){ reject text: Your mail Has been rejected due to mailsize control\n\n.;";
    $activescript .= "stop;}";

    $self->{_sieve}->putscript($script_name, $activescript);
    $self->{_sieve}->logout; 
    return 1;       
}
1;

sieve.wsdl

<?xml version="1.0"?>
<definitions xmlns="http://schemas.xmlsoap.org/wsdl/" xmlns:soap="http://schemas.xmlsoap.org/wsdl/soap/" xmlns:tns="urn:manageSieve" xmlns:xsd="http://www.w3.org/2001/XMLSchema" name="HelloService" targetNamespace="urn:manageSieve" xmlns:y="urn:manageSieve">
<message name="updateSieveFilterRequest">
    <part name="client_code" type="xsd:string"/>
</message>
<message name="updateSieveFilterResponse">
    <part name="Result" type="xsd:string"/>
</message>
<portType name="Hello_PortType">
    <operation name="updateSieveFilter">
        <input message="tns:updateSieveFilterRequest"/>
        <output message="tns:updateSieveFilterResponse"/>
    </operation>
</portType>
<binding name="Hello_Binding" type="tns:Hello_PortType">
    <soap:binding style="rpc" transport="http://schemas.xmlsoap.org/soap/http"/>
    <operation name="updateSieveFilter">
        <soap:operation soapAction="urn:manageSieve#updateSieveFilter"/>
        <input>
        <soap:body encodingStyle="http://schemas.xmlsoap.org/soap/encoding/" namespace="urn:manageSieve" use="encoded"/>
        </input>
        <output>
        <soap:body encodingStyle="http://schemas.xmlsoap.org/soap/encoding/" namespace="urn:manageSieve" use="encoded"/>
        </output>
    </operation>
</binding>
<service name="Hello_Service">
<documentation>WSDL File for HelloService</documentation>
<port binding="tns:Hello_Binding" name="Hello_Port">
    <soap:address location="http://sieve.net/sievefilter_thread.pl"/>
</port>
</service>
</definitions>

soap_client.pl

use SOAP::Lite;
my $client = SOAP::Lite->service("http://sieve.net/sieve.wsdl");
my $result = $client->updateSieveFilter(17);
print $result;

Answer 1

I am a bit confused about your threading code. You have to pass work into queue before creating the threads and process them after they are done.

$Qresults->enqueue( undef ); ## Signal this thread is finished <-- this is not needed

          foreach my $user (@users){
                    $Qwork->enqueue( $user );
                    if( $counter % 100 == 0){
                            sleep 1;
                    }
                    $counter++;
          }
           $Qwork->enqueue( (undef) x $THREADS );

            ## Create the pool of workers
            my @pool = map{
                    threads->create( \&updateClientUsersSieve, $Qwork, $Qresults )
            } 1 .. $THREADS;             
            # Clean up the threads          
            $_->join for @pool;
            ## Process the results as they become available
            while( $result = $Qresults->dequeue ) {
               print $result;
            }

            return 1;