1#!/usr/local/bin/perl -w
2
3# This is a simple job queue.
4
5use strict;
6use lib '../lib';
7
8# sub POE::Kernel::TRACE_DEFAULT () { 1 }
9# sub POE::Kernel::TRACE_GARBAGE () { 1 }
10# sub POE::Kernel::ASSERT_DEFAULT () { 1 }
11
12use POE;
13
14### Configuration section.
15
16# This is the maximum number of children permitted to be running at
17# any moment.
18
19my $child_max = 5;
20
21### This is a "child" session.  The "parent" session will ensure that
22### $child_max of these are running at any given time.
23
24# The parent session needs to create children from two places.  Define
25# a handy constructor rather than maintain duplicate copies of this
26# POE::Session->create call.
27sub create_a_child {
28  POE::Session->create
29    ( inline_states =>
30      { _start  => \&child_start,
31        _stop   => \&child_stop,
32        wake_up => \&child_awaken,
33      },
34    );
35}
36
37# The child session has started.  Pretend to do something for a random
38# amount of time.
39sub child_start {
40  my ($kernel, $session, $parent, $heap) = @_[KERNEL, SESSION, SENDER, HEAP];
41
42  # Remember the parent.
43  $heap->{parent} = $parent;
44
45  # Take a random amount of time to "do" the "job".
46  my $delay = int rand 10;
47  warn "Child ", $session->ID, " will take $delay seconds to run.\n";
48  $kernel->delay( wake_up => $delay );
49}
50
51# The child has finished whatever it was supposed to do.  Send the
52# result of its labor back to the parent.
53sub child_awaken {
54  my ($kernel, $session, $heap) = @_[KERNEL, SESSION, HEAP];
55
56  # Fabricate the hypothetical job's result.
57  my $result = int rand 100;
58  warn "Child ", $session->ID, " is done doing something.  Result=$result\n";
59
60  # Post the result back to the parent.  The child has nothing left to
61  # do, and so it stops.
62  $kernel->post($heap->{parent}, 'result', $session->ID, $result);
63}
64
65# The child has stopped.  Display a message to help illustrate what's
66# going on.
67sub child_stop {
68  my $session = $_[SESSION];
69  warn "Child ", $session->ID, " is stopped.\n";
70}
71
72### This is the "parent" session.  One of these will ensure that
73### $child_max children are running beneath it.  It's possible to have
74### several parent sessions; each will manage a separate pool of
75### children.
76
77# The parent session is starting.  Populate its pool with an initial
78# group of child sessions.
79sub parent_start {
80  $_[HEAP]->{child_count} = 0;
81  for (my $i=0; $i<$child_max; $i++) {
82    &create_a_child;
83  }
84}
85
86# The parent has either gained a new child or lost an existing one.
87# If a new child is gained, track it.  If an existing child is lost,
88# then spawn a replacement.
89sub parent_child {
90  my ($heap, $what, $child) = @_[HEAP, ARG0, ARG1];
91
92  # This child is arriving, either by being created or by being
93  # abandoned by some other session.  Count it as a child in our pool.
94  if ($what eq 'create' or $what eq 'gain') {
95    $heap->{child_count}++;
96    warn( "Child ", $child->ID, " has appeared to parent ",
97          $_[SESSION]->ID, " (", $heap->{child_count},
98          " active children now).\n"
99        );
100  }
101
102  # This child is departing.  Remove it from our pool count; if we
103  # have fewer children than $child_max, then spawn a new one to take
104  # the departing child's place.
105  elsif ($what eq 'lose') {
106    $heap->{child_count}--;
107    warn( "Child ", $child->ID, " has left parent ",
108          $_[SESSION]->ID, " (", $heap->{child_count},
109          " active children now).\n"
110        );
111    if ($heap->{child_count} < $child_max) {
112      &create_a_child;
113    }
114  }
115}
116
117# Receive a child session's result.
118sub parent_result {
119  my ($child, $result) = @_[ARG0, ARG1];
120  warn "Parent received result from session $child: $result\n";
121}
122
123# Track when the parent leaves.
124sub parent_stop {
125  warn "Parent ", $_[SESSION]->ID, " stopped.\n";
126}
127
128### Main loop.  Start a parent session, which will, in turn, start its
129### children.  Run until everything is done; in this case, until the
130### user presses Ctrl+C.  Note: The children which are currently
131### "working" will continue after Ctrl+C until they are "done".
132
133POE::Session->create
134  ( inline_states =>
135    { _start => \&parent_start,
136      _stop  => \&parent_stop,
137      _child => \&parent_child,
138      result => \&parent_result,
139    }
140  );
141
142$poe_kernel->run();
143
144exit;
145