Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Newer
Older
100644 145 lines (117 sloc) 4.206 kB
00c774c @rcaputo oops... add queue sample back
authored
1 #!/usr/bin/perl -w
2
3 # This is a simple job queue.
4
5 use strict;
0901706 @rcaputo Clean up paths to point to the new lib/ directory.
authored
6 use lib '../lib';
00c774c @rcaputo oops... add queue sample back
authored
7
8 # sub POE::Kernel::TRACE_DEFAULT () { 1 }
9 # sub POE::Kernel::TRACE_GARBAGE () { 1 }
10 # sub POE::Kernel::ASSERT_DEFAULT () { 1 }
11
12 use POE;
13
14 ### Configuration section.
15
16 # This is the maximum number of children permitted to be running at
17 # any moment.
18
19 my $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.
27 sub 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.
39 sub 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.
53 sub 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.
67 sub 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.
79 sub 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.
89 sub 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.
118 sub 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.
124 sub 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
133 POE::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
144 exit;
Something went wrong with that request. Please try again.