lib/Stem/WorkQueue.pm

   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;