Simple Ithread test

[Venkatesan Saranathan]

Hi List,

I am trying to create a very simple program using Perl threads. My
test program accepts list of host names from command line, creates a
separate thread for each host name and within the thread, it pings the
given host and stores the result in a shared hash.   But this is
giving unpredictable results so far.  It seems to be working fine on
Windows 2000 but not on Windows XP.

Any ideas?  I am using ActivePerl 5.8.7.

The program listing is given below.

#!/bin/perl -w
#

use strict;
use threads;
use threads::shared;

use Net::Ping;

# Mark this hash sharable by all threads.
my %status : shared;

my $MAX_THREADS = 20;

main();

# returns the total number of threads in the threads list.
sub get_thread_count {
   my (@threads);
   return(scalar(@threads = threads->list));
}

# if the current number of threads is equal to/greater than the
# predefined limit, then releases the completed threads until the
# running threads becomes less than the maximum limit for threads.
sub wait_for_threads {
   my ($thread_count) = @_;
   my (@thread_list, $thread);
   @thread_list = threads->list;

   while (get_thread_count() >= $thread_count) {
       $thread = shift(@thread_list);
       if ($thread->tid && !threads::equal($thread, threads->self)) {
           $thread->join;
       }
   }
}

sub main {
   my ($thread, $host);
   while (<>) {
       chomp;
       threads->new(\&ping_host, $_);

       if (get_thread_count() >= $MAX_THREADS) {
           print "Max thread limit reached: ", get_thread_count(), "\n";
           wait_for_threads($MAX_THREADS - 10);
       }
   }

   # wait for all the currently running threads to finish.
   foreach $thread (threads->list) {
       # Main thread has a thread id of zero. Skip the main thread
       # and this thread while joining.
       if ($thread->tid && !threads::equal($thread, threads->self)) {
           $thread->join;
       }
   }

   # at this point, all the threads have finished and the result is
   # in the hash.  Print the status by looping thru the keys.
   foreach $host (sort keys %status) {
       print "$host is $status{$host}.\n";
   }
}

sub ping_host {
   use Net::Ping;
   my ($host) = @_;
   my ($p, $result);

   $p = Net::Ping->new();
   $result = ($p->ping($host)) ? "alive" : "unreachable";
   $p->close();

   # good idea to lock the hash before making modification
   lock(%status);

   $status{$host} = $result;
}

Thanks,

with warm regards,
Venkat Saranathan.

--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
<http://learn.perl.org/> <http://learn.perl.org/first-response>