Thread::Running - provide non-blocking check whether threads are running

    use Thread::Running;      # exports running(), exited() and tojoin()
    use Thread::Running qw(running);   # only exports running()
    use Thread::Running ();   # threads methods only

    my $thread = threads->new( sub { whatever } );
    while ($thread->running) {
    # do your stuff
    }

    $_->join foreach threads->tojoin;

    until (threads->exited( $tid )) {
    # do your stuff
    }

    sleep 1 while threads->running;

                  *** A note of CAUTION ***

 This module only functions on Perl versions 5.8.0 and later.
 And then only when threads are enabled with -Dusethreads.  It
 is of no use with any version of Perl before 5.8.0 or without
 threads enabled.

                  *************************

 sleep 1 while threads->running; # wait until all threads stopped running

 sleep 1 while $thread->running; # wait until this thread stopped running

 @running = threads->running( @thread );  # list of threads still running

 while (running( @tid )) {  # subroutine: while at least 1 is still running
 # do your stuff
 }

 sleep 1 until threads->tojoin; # wait until any thread can be joined

 sleep 1 until $thread->tojoin; # wait until this thread can be joined

 warn "Come on and join!\n" if threads->tojoin( $thread );

 $_->join foreach threads->tojoin; # join all joinable threads

 sleep 1 until $thread->exited; # wait until this thread exited

 sleep 1 until threads->exited; # wait until all threads exited

 @exited = threads->exited( @thread ); # threads that have exited

 until (exited( @tid )) { # subroutine: until all have exited
 # do your stuff
 }

 load (any)
 Thread::Exit (0.06)

package Thread::Running;

# Make sure we have version info for this module
# Make sure we do everything by the book from now on

$VERSION = '0.07';
use strict;

# Only load the things we need on demand

use load;

# Make sure we can do threads
# Make sure we can do shared variables

use threads ();
use threads::shared ();

# Shared hash for keeping exited threads
#  ''    = thread did not start at all
#  undef = thread started successfully
#  0     = thread detached
#  1     = undetached thread exited
#  2     = thread joined or detached thread exited

our %status : shared;

# Enable Thread::Exit with thread marking stuff

use Thread::Exit

# Obtain the thread ID
# Set to joined if marked as detached, else as undetached exited

    end => sub {
        my $tid = threads->tid;
        $status{$tid} = 1 + defined $status{$tid};
    },
;

# Make sure we do this before anything else
#  Allow for dirty tricks

BEGIN {
    no strict 'refs'; no warnings 'redefine';
    my $new = \&threads::new; # closure!
    *threads::new = *threads::create = sub {
        my $thread = $new->( @_ );
        $status{$thread->tid} = undef;
        $thread;
    };

#  Keep reference to current detach routine
#  Hijack the thread detach routine with a sub that sets detached status
#  Keep reference to current join routine
#  Hijack the thread join routine with a sub that sets joined status

    my $detach = \&threads::detach; # closure!
    *threads::detach = sub { $status{$_[0]->tid} = 0; return &$detach };
    my $join = \&threads::join; #closure!
    *threads::join = sub { $status{$_[0]->tid} = 2; return &$join };
} #BEGIN

# Satisfy -require-

1;

#---------------------------------------------------------------------------

# Stuff that should really be in threads.pm

#---------------------------------------------------------------------------
#  IN: 1 class (ignored) or object to be checked
#      2..N additional thread (ID's) that should be checked (default: all)
# OUT: 1..N thread ID's that are still running

sub threads::running {

# Lose the class
# Go do the actual check

    shift unless ref $_[0];
    return &running;
} #threads::running

#---------------------------------------------------------------------------
#  IN: 1 class (ignored) or object to be checked
#      2..N additional thread (ID's) that should be checked (default: all)
# OUT: 1..N thread ID's that can be join()ed

sub threads::tojoin {

# Lose the class
# Go do the actual check

    shift unless ref $_[0];
    return &tojoin;
} #threads::tojoin

#---------------------------------------------------------------------------
#  IN: 1 class (ignored) or object to be checked
#      2..N additional thread (ID's) that should be checked (default: all)
# OUT: 1..N thread ID's that have exited

sub threads::exited {

# Lose the class
# Go do the actual check

    shift unless ref $_[0];
    return &exited;
} #threads::exited

#---------------------------------------------------------------------------

# The following subroutines are loaded only when they are needed

__END__

#---------------------------------------------------------------------------

# The subroutines

#---------------------------------------------------------------------------
#  IN: 1..N thread (ID's) that should be checked (default: all)
# OUT: 1..N thread ID's that are still running

sub running {

# For all of the threads specified
#  Make sure we have a thread ID
#  Reloop if we haven't seen this thread start or it has exited already
#  Return with succes now if in scalar context
#  Add thread ID to list
# Return list of thread ID's that have exited

    my @tid;
    foreach (@_ ? @_ : _listall()) {
        my $tid = ref( $_ ) ? $_->tid : $_;
        next if !exists $status{$tid} or $status{$tid};
        return 1 unless wantarray;
        push @tid,$tid;
    }
    @tid;
} #running

#---------------------------------------------------------------------------
#  IN: 1..N thread (ID's) that should be checked (default: all)
# OUT: 1..N threads that can be joined

sub tojoin {

# For all of the threads specified
#  Reloop if this thread is not ready to be joined
#  Return with succes now if in scalar context
#  Add thread ID to list if exited
# Return now if there are no objects

    my @tid;
    foreach (@_ ? @_ : _listall( 1 )) {
        my $tid = ref( $_ ) ? $_->tid : $_;
        next unless ($status{$tid} || 0) == 1;
        return 1 unless wantarray;
        push @tid,$tid;
    }
    return () unless @tid;

# Create hash of thread objects keyed to thread ID's
# Return the appropriate objects

    my %thread = map { $_->tid => $_ } threads->list;
    @thread{@tid};
} #tojoin

#---------------------------------------------------------------------------
#  IN: 1..N thread ID's that should be checked (default: all)
# OUT: 1..N threads that exited

sub exited {

# Set the threads to work on
# Return success if scalar context and nothing to check

    @_ = _listall() unless @_;
    return 1 unless wantarray or @_;

# For all of the threads specified
#  Return with failure now if in scalar context and not exited
#  Add thread ID to list if exited
# Return list of thread ID's that have exited or flag if all

    my @tid;
    foreach (@_) {
        my $tid = ref( $_ ) ? $_->tid : $_;
        return 0 unless wantarray or $status{$tid};
        push @tid,$tid;
    }
    return wantarray ? @tid : @tid == @_;
} #exited

#---------------------------------------------------------------------------

# Methods needed by Perl

#---------------------------------------------------------------------------
#  IN: 1 class
#      2..N subroutines to export

sub import {

# Lose the class
# Obtain the namespace
# Set the defaults if nothing specified
# Allow for evil stuff
# Export whatever needs to be exported

    shift;
    my $namespace = (scalar caller() ).'::';
    @_ = qw(exited running tojoin) unless @_;
    no strict 'refs';
    *{$namespace.$_} = \&$_ foreach @_;
} #import

#---------------------------------------------------------------------------

# Internal subroutines

#---------------------------------------------------------------------------
# OUT: 1..N all the thread ID's currently running (including detached threads)

sub _listall {

# For all the threads that we know about
#  Keep the thread ID if it's still running
# Return whatever we got

    my @tid;
    while (my $tid = each %status) {
        push @tid,$tid unless ($status{$tid} || 0) == 2;
    }
    @tid;
} #_listall

#---------------------------------------------------------------------------

__END__