Commit | Line | Data |
4536f655 |
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 ; |