lib/Stem/Cell/Sequence.pm

   1 #  File: Stem/Cell/Sequence.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::Cell ;
  30
  31 use strict ;
  32
  33 sub cell_set_sequence {
  34
  35         my( $self, @sequence ) = @_ ;
  36
  37         my $cell_info = $self->_get_cell_info() ;
  38
  39 #print "@sequence\n" ;
  40
  41         $cell_info->{'sequence'} = [ @sequence ] ;
  42         $cell_info->{'sequence_left'} = [ @sequence ] ;
  43
  44         return ;
  45 }
  46
  47
  48 sub cell_reset_sequence {
  49
  50         my( $self ) = @_ ;
  51
  52         my $cell_info = $self->_get_cell_info() ;
  53
  54         $cell_info->{'sequence_left'} = [ @{$cell_info->{'sequence'}} ] ;
  55
  56         return ;
  57 }
  58
  59 sub cell_replace_next_sequence {
  60
  61         my( $self, $method ) = @_ ;
  62
  63         my $cell_info = $self->_get_cell_info() ;
  64
  65         $cell_info->{'sequence_left'}[0] = $method;
  66
  67         return ;
  68 }
  69
  70 #
  71 # This method lets you basically set up loops.  For example, method X
  72 # could insert itself as the next next method in the sequence.  Then,
  73 # when it is called again it can decide whether or not to insert
  74 # itself again.
  75 #
  76 # A more complex example might see method X might say "now execute Y,
  77 # Z, M, and X", which allows you to create loops.  Then method Z might
  78 # say "now execute Q and Z".
  79 #
  80 # Obviously, most loops will also need a break condition where method
  81 # X decides _not_ to insert itself into the sequence.
  82 #
  83 sub cell_insert_next_sequence {
  84
  85         my( $self, @sequence ) = @_ ;
  86
  87         my $cell_info = $self->_get_cell_info() ;
  88
  89         unshift @{ $cell_info->{'sequence_left'} }, @sequence;
  90
  91         return ;
  92 }
  93
  94 sub cell_skip_next_sequence {
  95
  96         my( $self, $count ) = @_ ;
  97
  98         $count ||= 1 ;
  99
 100         my $cell_info = $self->_get_cell_info() ;
 101
 102         shift @{ $cell_info->{'sequence_left'} } for 1..$count;
 103
 104         return ;
 105 }
 106
 107 sub cell_skip_until_method {
 108
 109         my( $self, $method ) = @_ ;
 110
 111         my $cell_info = $self->_get_cell_info() ;
 112
 113         my $seq_left = $cell_info->{'sequence_left'} ;
 114
 115         while( @{$seq_left} ) {
 116
 117                 return if $seq_left->[0] eq $method ;
 118                 shift @{$seq_left} ;
 119         }
 120
 121         die "skip sequence method $method is not found" ;
 122 }
 123
 124
 125 sub cell_next_sequence_in {
 126
 127         my( $self, $msg ) = @_ ;
 128
 129 #print $msg->dump( "NEXT IN" ) if $msg ;
 130
 131         my $cell_info = $self->_get_cell_info() ;
 132
 133         $cell_info->cell_next_sequence( $msg ) ;
 134 }
 135
 136 sub cell_next_sequence {
 137
 138         my( $self, $in_msg ) = @_ ;
 139
 140 #print caller(), "\n" ;
 141
 142 #print $in_msg->dump('SEQ IN') if $in_msg ;
 143
 144         my $cell_info = $self->_get_cell_info() ;
 145
 146         my $owner_obj = $cell_info->{'owner_obj'} ;
 147
 148
 149         while( my $next_sequence = shift @{$cell_info->{'sequence_left'}} ) {
 150
 151 #print "LEFT @{$cell_info->{'sequence_left'}}\n" ;
 152
 153                 die "cannot call sequence method $next_sequence"
 154                         unless $owner_obj->can( $next_sequence ) ;
 155
 156 #print "SEQ: $next_sequence\n" ;
 157
 158                 my $seq_val = $owner_obj->$next_sequence( $in_msg ) ;
 159
 160 # don't pass in the message more than once.
 161
 162                 $in_msg = undef ;
 163
 164                 next unless $seq_val ;
 165
 166                 if ( ref $seq_val eq 'Stem::Msg' ) {
 167
 168
 169 #print caller() ;
 170 #print $seq_val->dump( 'SEQ: MSG' ) ;
 171                         $seq_val->reply_type( 'cell_next_sequence' ) ;
 172
 173                         $seq_val->dispatch() ;
 174
 175                         return ;
 176                 }
 177
 178                 if ( ref $seq_val eq 'HASH' ) {
 179
 180                         my $delay = $seq_val->{'delay'} ;
 181
 182                         if ( defined( $delay ) ) {
 183
 184                                 $cell_info->cell_sequence_delay( $delay ) ;
 185                                 return ;
 186                         }
 187                 }
 188         }
 189
 190         if ( my $seq_done_method = $cell_info->{'sequence_done_method'} ) {
 191
 192                 $owner_obj->$seq_done_method() ;
 193
 194                 return ;
 195         }
 196
 197 #warn "FELL off end of sequence" ;
 198
 199         return ;
 200 }
 201
 202 sub cell_sequence_delay {
 203
 204         my( $self, $delay ) = @_ ;
 205
 206         my $cell_info = $self->_get_cell_info() ;
 207
 208 #print "SEQ DELAY $delay\n" ;
 209
 210         $cell_info->{'timer'} = Stem::Event::Timer->new(
 211                                 'object'        => $cell_info,
 212                                 'method'        => 'cell_next_sequence',
 213                                 'delay'         => $delay,
 214                                 'hard'          => 1,
 215                                 'single'        => 1,
 216         ) ;
 217 }
 218
 219 1 ;