Commit | Line | Data |
4536f655 |
1 | # File: Stem/WorkQueue.pm |
2 | |
3 | # This file is part of Stem. |
4 | # Copyright (C) 1999, 2000, 2001 Stem Systems, Inc. |
5 | |
6 | # Stem is free software; you can redistribute it and/or modify |
7 | # it under the terms of the GNU General Public License as published by |
8 | # the Free Software Foundation; either version 2 of the License, or |
9 | # (at your option) any later version. |
10 | |
11 | # Stem is distributed in the hope that it will be useful, |
12 | # but WITHOUT ANY WARRANTY; without even the implied warranty of |
13 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
14 | # GNU General Public License for more details. |
15 | |
16 | # You should have received a copy of the GNU General Public License |
17 | # along with Stem; if not, write to the Free Software |
18 | # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA |
19 | |
20 | # For a license to use the Stem under conditions other than those |
21 | # described here, to purchase support for this software, or to purchase a |
22 | # commercial warranty contract, please contact Stem Systems at: |
23 | |
24 | # Stem Systems, Inc. 781-643-7504 |
25 | # 79 Everett St. info@stemsystems.com |
26 | # Arlington, MA 02474 |
27 | # USA |
28 | |
29 | package Stem::WorkQueue ; |
30 | |
31 | use strict ; |
32 | |
33 | my $attr_spec = [ |
34 | |
35 | ] ; |
36 | |
37 | |
38 | ########### |
39 | # This POD section is autoegenerated. Any edits to it will be lost. |
40 | |
41 | =head2 Constructor Attributes for Class Stem::WorkQueue |
42 | |
43 | =over 4 |
44 | |
45 | |
46 | =back |
47 | |
48 | =cut |
49 | |
50 | # End of autogenerated POD |
51 | ########### |
52 | |
53 | |
54 | |
55 | sub new { |
56 | |
57 | my( $class ) = shift ; |
58 | |
59 | my $self = Stem::Class::parse_args( $attr_spec, @_ ) ; |
60 | return $self unless ref $self ; |
61 | |
62 | $self->{ 'work_queue' } = [] ; |
63 | $self->{ 'worker_queue' } = [] ; |
64 | |
65 | return $self ; |
66 | } |
67 | |
68 | sub msg_in { |
69 | |
70 | my ( $self, $msg ) = @_ ; |
71 | |
72 | push( @{$self->{ 'work_queue' }}, $msg ) ; |
73 | |
74 | $self->_check_for_work() ; |
75 | |
76 | return ; |
77 | } |
78 | |
79 | sub worker_in { |
80 | |
81 | my ( $self, $msg ) = @_ ; |
82 | |
83 | #print $msg->dump('worker') ; |
84 | |
85 | push( @{$self->{ 'worker_queue' }}, $msg ) ; |
86 | |
87 | $self->_check_for_work() ; |
88 | |
89 | return ; |
90 | } |
91 | |
92 | sub _check_for_work { |
93 | |
94 | my ( $self ) = @_ ; |
95 | |
96 | my $work_q = $self->{ 'work_queue' } ; |
97 | my $worker_q = $self->{ 'worker_queue' } ; |
98 | |
99 | while( 1 ) { |
100 | |
101 | # see if we have both workers and work to do |
102 | |
103 | return unless @{$work_q} && @${worker_q} ; |
104 | |
105 | my $work_msg = shift @{$work_q} ; |
106 | my $worker_msg = shift @{$worker_q} ; |
107 | |
108 | #print "WORK out [", Store( $worker_msg->from() ), "]\n" ; |
109 | |
110 | $work_msg->to( scalar $worker_msg->from() ) ; |
111 | |
112 | #print $work_msg->dump( 'work' ) ; |
113 | $work_msg->dispatch() ; |
114 | } |
115 | } |
116 | |
117 | sub status_cmd { |
118 | |
119 | my ($self) = @_ ; |
120 | |
121 | my $work_cnt = @{$self->{ 'work_queue' }} ; |
122 | my $worker_cnt = @{$self->{ 'worker_queue' }} ; |
123 | |
124 | return <<STATUS ; |
125 | |
126 | Work Queue: $work_cnt |
127 | Worker Queue: $worker_cnt |
128 | |
129 | STATUS |
130 | |
131 | } |
132 | |
133 | 1; |