I am working to converting a UPnP DLNA server perl script that someone else wrote for linux to run under windows. I have spent the last couple of evenings trying to resolve some strange behavior with threads.

I have reduced the problem down to a short script and a short perl module which are listed at the bottom of this post.

The situation develops when a multicast socket, created by the main script by calling a subroutine in a package, is accessed by another subroutine in the same package which is running in a thread. What happens is that all the threads hang and the main script hangs when it goes to create the another thread.

In the example below I have set it up so that when the script is run with a 0 passed to createsock it creates a udp socket in the same thread and subroutine that access it. When run in this mode the script runs as expected printing a number of debug messages and then a message block when the script exists that the script ended with 1 thread running. When the script is run with a 1 passed to createsock the udp socket is created in a separate routine in the package. In this case the script prints "start sub 1" and then "above mysub2" where it hangs.

I expect that the problem has something to do with the Windows thread implementation and accessing the $sock variable in the main body of the script and then in a thread.

I would like to fix it in a way that would run both under linux and windows. As I don't have a lot of experience with threads I am looking to the collective wisdom of the perl monks on the most appropriate way to do this.

Your feedback is very much appreciated. I hope I have provided the right amount of information but if there is something else that is needed please let me know.

digitalhack
Rockville, MD

perl script:

use strict;

use threads;
use lib ('./');
use TEST::TEST;

TEST::TEST::createsock(1);

my $t1 = threads->create(\&TEST::TEST::mysub1, 1, "test 1");

select(undef, undef, undef, .25);

print "above mysub2\n";

my $t2 = threads->create(\&TEST::TEST::mysub2, 2, "test 2");

print "below mysub2\n";

$t2->join();
[download]

perl module:

package TEST::TEST;
use strict;

use threads;

use IO::Socket::Multicast;

our $sock = undef;

sub createsock {
  my $create = shift @_;
  if ($create) {
    $sock = IO::Socket::Multicast->new(Proto=>'udp',LocalPort=>2200);
    $sock->mcast_add('226.1.1.2') || die "Couldn't set group: $!\n";
  }
}

sub mysub1 {
  my ($sub, $msg) = shift @_;

  print "start sub $sub\n";
  #my $key = getc(STDIN);
  my $data;
  if ($sock == undef) {
    $sock = IO::Socket::Multicast->new(Proto=>'udp',LocalPort=>2200);
    $sock->mcast_add('226.1.1.2') || die "Couldn't set group: $!\n";
  }
  $sock->recv($data,1024);
  print "end sub $sub\n";
}

sub mysub2 {
  my ($sub, $msg) = shift @_;

  print "start sub $sub\n";
  print "msg from sub $sub: $msg\n";
  print "end sub $sub\n";
}

1;
[download]