xref: /openbsd-src/gnu/usr.bin/perl/dist/Thread-Queue/examples/queue.pl (revision f2a19305cfc49ea4d1a5feb55cd6c283c6f1e031)
1*f2a19305Safresh1#!/usr/bin/env perl
2*f2a19305Safresh1
3*f2a19305Safresh1use strict;
4*f2a19305Safresh1use warnings;
5*f2a19305Safresh1
6*f2a19305Safresh1use threads;
7*f2a19305Safresh1use Thread::Queue 3.01;
8*f2a19305Safresh1
9*f2a19305Safresh1# Create a work queue for sending data to a 'worker' thread
10*f2a19305Safresh1#   Prepopulate it with a few work items
11*f2a19305Safresh1my $work_q = Thread::Queue->new(qw/foo bar baz/);
12*f2a19305Safresh1
13*f2a19305Safresh1# Create a status queue to get reports from the thread
14*f2a19305Safresh1my $status_q = Thread::Queue->new();
15*f2a19305Safresh1
16*f2a19305Safresh1# Create a detached thread to process items from the queue
17*f2a19305Safresh1threads->create(sub {
18*f2a19305Safresh1                    # Keep grabbing items off the work queue
19*f2a19305Safresh1                    while (defined(my $item = $work_q->dequeue())) {
20*f2a19305Safresh1                        # Process the item from the queue
21*f2a19305Safresh1                        print("Thread got '$item'\n");
22*f2a19305Safresh1
23*f2a19305Safresh1                        # Ask for more work when the queue is empty
24*f2a19305Safresh1                        if (! $work_q->pending()) {
25*f2a19305Safresh1                            print("\nThread waiting for more work\n\n");
26*f2a19305Safresh1                            $status_q->enqueue('more');
27*f2a19305Safresh1                        }
28*f2a19305Safresh1                    }
29*f2a19305Safresh1
30*f2a19305Safresh1                    # Final report
31*f2a19305Safresh1                    print("Thread done\n");
32*f2a19305Safresh1                    $status_q->enqueue('done');
33*f2a19305Safresh1
34*f2a19305Safresh1                })->detach();
35*f2a19305Safresh1
36*f2a19305Safresh1# More work for the thread
37*f2a19305Safresh1my @work = (
38*f2a19305Safresh1    [ 'bippity', 'boppity', 'boo' ],
39*f2a19305Safresh1    [ 'ping', 'pong' ],
40*f2a19305Safresh1    [ 'dit', 'dot', 'dit' ],
41*f2a19305Safresh1);
42*f2a19305Safresh1
43*f2a19305Safresh1# Send work to the thread
44*f2a19305Safresh1while ($status_q->dequeue() eq 'more') {
45*f2a19305Safresh1    last if (! @work);   # No more work
46*f2a19305Safresh1    $work_q->enqueue(@{shift(@work)});
47*f2a19305Safresh1}
48*f2a19305Safresh1
49*f2a19305Safresh1# Signal that there is no more work
50*f2a19305Safresh1$work_q->end();
51*f2a19305Safresh1# Wait for thread to terminate
52*f2a19305Safresh1$status_q->dequeue();
53*f2a19305Safresh1# Good-bye
54*f2a19305Safresh1print("Done\n");
55*f2a19305Safresh1
56*f2a19305Safresh1# EOF
57