Threads durchlaufen

loop-threads.pl

#!/usr/bin/env perl
# Siehe auch: https://www.perl-community.de/bat/poard/thread/20656

use diagnostics;
use strict;
use utf8;
use warnings;
use threads;

# Threard Start Handler

sub start_handler {

    # Aufgabe ausführen (hier sleep) und Ergebnis zurückgeben
    my ( $i, $rand ) = @_;
    print "Start thread $i; Sleeping $rand seconds...\n";
    sleep $rand;
    return ( $i, $rand );
}

# Threard Stop Handler

sub stop_handler {

    # Ergebnis auswerten
    my ( $i, $rand ) = @_;
    print "Stop/join thread $i\n";
}

# Threads durchlaufen

sub loop_threads {

    my ( $handler_sub, $max_threads ) = @_;

    do {

        for (
            ($max_threads)
            ? threads->list(threads::joinable)
            : threads->list()
          )
        {
            if ($handler_sub) {
                &{$handler_sub}( $_->join );
            }
            else {
                $_->join;
            }
        }

        # Keine "Slots" frei; D.h. warten bis Threads abgearbeitet wurden
        # und nochmal loop_threads durchlaufen

    } while ( $max_threads && threads->list >= $max_threads && sleep 3 );

}

my $max_threads = 8;    # Maximale Anzahl Threads/Slots

for ( my $i = 0 ; $i < 100 ; $i++ ) {
    my $rand = int( rand(10) );
    threads->create( { "context" => "list" }, \&start_handler, ( $i, $rand ) );
    loop_threads( \&stop_handler, $max_threads );
}

# Als letztes alle übrigen Threads joinen; D.h. auf den letzten warten...
loop_threads( \&stop_handler );