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.