Commit | Line | Data |
4536f655 |
1 | # File: Stem/Route.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::Route; |
30 | |
31 | #use Stem::Trace 'log' => 'stem_status', 'sub' => 'TraceStatus' ; |
32 | #use Stem::Trace 'log' => 'stem_error' , 'sub' => 'TraceError' ; |
33 | |
34 | use strict ; |
35 | |
36 | use base 'Exporter' ; |
37 | use vars qw( %EXPORT_TAGS ) ; |
38 | |
39 | %EXPORT_TAGS = ( |
40 | 'cell' => [ qw( |
41 | register_cell |
42 | alias_cell |
43 | unregister_cell |
44 | lookup_cell |
45 | lookup_cell_name |
46 | register_class |
47 | ) ], |
48 | 'filter' => [ qw( |
49 | push_filter_on_cell |
50 | pop_filter_from_cell |
51 | ) ], |
52 | ) ; |
53 | |
54 | Exporter::export_ok_tags( qw( cell filter ) ); |
55 | |
56 | use constant DEBUG => 1; |
57 | |
58 | my %cell_info ; |
59 | my %cell_name_to_obj ; |
60 | |
61 | register_class( __PACKAGE__, 'reg' ) ; |
62 | |
63 | #use diagnostics -verbose; |
64 | |
65 | ## registration takes a minimum args of an object and a name. |
66 | ## an optional third arg of target is also accepted. |
67 | ## |
68 | ## the idea here is that when a portal connects, it's registered |
69 | ## with the local hub - which makes everyone aware of the new |
70 | ## portal. |
71 | ## |
72 | ## a couple remaining questions though .. should this registration |
73 | ## include the capabilities of the new portal? should we add |
74 | ## an 'authentication' capability to the registration process? |
75 | ## ...just a few thoughts |
76 | |
77 | |
78 | sub register_cell { |
79 | |
80 | my( $obj, $name, $target ) = @_ ; |
81 | |
82 | unless( $obj && $name ) { |
83 | |
84 | my $err = <<ERR ; |
85 | register() requires an object and a name, with an optional target. |
86 | ERR |
87 | |
88 | # TraceError $err ; |
89 | |
90 | return $err ; |
91 | } |
92 | |
93 | $target = '' unless defined $target ; |
94 | |
95 | if ( $cell_name_to_obj{ $name }{ $target } ) { |
96 | |
97 | my $err = |
98 | "register_Cell $name:$target is already registered\n" ; |
99 | |
100 | return $err ; |
101 | } |
102 | |
103 | $cell_name_to_obj{ $name }{ $target } = $obj ; |
104 | |
105 | $cell_info{ $obj }{'names'}{ $name }{ $target } = 1 ; |
106 | $cell_info{ $obj }{'primary_name'} ||= [ $name, $target ] ; |
107 | |
108 | return ; |
109 | } |
110 | |
111 | sub register_class { |
112 | |
113 | my( $class, @nicks ) = @_ ; |
114 | |
115 | foreach my $name ( $class, @nicks ) { |
116 | |
117 | register_cell( $class, $name ) ; |
118 | } |
119 | } |
120 | |
121 | sub alias_cell { |
122 | |
123 | my( $obj, $name, $target ) = @_ ; |
124 | |
125 | unless( $obj && $name ) { |
126 | |
127 | my $err = <<ERR ; |
128 | alias_cell() requires an object and a name, with an optional target. |
129 | ERR |
130 | |
131 | # TraceError $err ; |
132 | |
133 | return $err ; |
134 | } |
135 | |
136 | $target = '' unless defined $target ; |
137 | |
138 | |
139 | unless ( lookup_cell( $name, $target ) ) { |
140 | |
141 | my $err = "Alias_cell: $name:$target is not registered\n" ; |
142 | |
143 | # TraceError $err ; |
144 | |
145 | return $err ; |
146 | } |
147 | |
148 | $cell_name_to_obj{ $name }{ $target } = $obj ; |
149 | $cell_info{ $obj }{'names'}{ $name }{ $target } = 1 ; |
150 | |
151 | |
152 | return ; |
153 | } |
154 | |
155 | sub unregister_cell { |
156 | |
157 | my( $obj ) = shift ; |
158 | |
159 | my $info_ref = $cell_info{ $obj } ; |
160 | |
161 | unless ( $info_ref ) { |
162 | |
163 | my $err = "unregister_cell: object [$obj] is not registered" ; |
164 | return $err ; |
165 | } |
166 | |
167 | foreach my $name ( keys %{ $info_ref->{'names'} } ) { |
168 | |
169 | foreach my $target ( |
170 | keys %{ $info_ref->{'names'}{$name} } ) { |
171 | |
172 | delete $cell_name_to_obj{ $name }{ $target } ; |
173 | delete $cell_name_to_obj{ $name } if $target eq '' ; |
174 | } |
175 | } |
176 | |
177 | delete $cell_info{ $obj } ; |
178 | |
179 | return ; |
180 | } |
181 | |
182 | |
183 | # this sub returns a cell if it is registered. otherwise it returns a |
184 | # proper false |
185 | # |
186 | # first check that the cell or parent cell exists. |
187 | # if it is a targeted address then find the targeted cell or its parent cell |
188 | # otherwise look for the regular cell with a null target. |
189 | |
190 | sub lookup_cell { |
191 | |
192 | my( $name, $target ) = @_ ; |
193 | |
194 | #print "LOOK N [$name] T [$target]\n" ; |
195 | return unless exists( $cell_name_to_obj{ $name } ) ; |
196 | |
197 | # look for a targeted cell first and then for a configured or class cell |
198 | |
199 | if ( defined $target ) { |
200 | |
201 | my $obj = $cell_name_to_obj{ $name }{ $target } ; |
202 | return $obj if $obj ; |
203 | } |
204 | |
205 | return $cell_name_to_obj{ $name }{''} ; |
206 | } |
207 | |
208 | |
209 | sub lookup_cell_name { |
210 | |
211 | my( $obj ) = @_ ; |
212 | |
213 | my $names_ref = $cell_info{ $obj }{'primary_name'} ; |
214 | |
215 | return ( @{$names_ref} ) if $names_ref ; |
216 | |
217 | return ; |
218 | } |
219 | |
220 | |
221 | sub push_filter_on_cell { |
222 | |
223 | my( $obj, $filter ) = @_ ; |
224 | |
225 | unless ( exists( $cell_info{ $obj } ) ) { |
226 | |
227 | my $err = "push_filter_on_cell: object [$obj] is not registered" ; |
228 | return $err ; |
229 | } |
230 | |
231 | push( @{ $cell_info{ $obj }{'filters'} }, $filter ) ; |
232 | |
233 | return ; |
234 | } |
235 | |
236 | sub pop_filter_on_cell { |
237 | |
238 | my( $obj ) = @_ ; |
239 | |
240 | unless ( exists( $cell_info{ $obj } ) ) { |
241 | |
242 | my $err = "pop_filter_on_cell: object [$obj] is not registered" ; |
243 | return $err ; |
244 | } |
245 | |
246 | pop( @{ $cell_info{ $obj }{'filters'} } ) ; |
247 | |
248 | return ; |
249 | } |
250 | |
251 | sub get_cell_filters { |
252 | |
253 | my( $obj ) = @_ ; |
254 | |
255 | return ( wantarray ) ? @{ $cell_info{ $obj }{'filters'} } : |
256 | $cell_info{ $obj }{'filters'} ; |
257 | } |
258 | |
259 | |
260 | sub status_cmd { |
261 | |
262 | my( $class, $msg ) = @_ ; |
263 | |
264 | my ( @cell_lines, %class_cell_texts ) ; |
265 | |
266 | #print map "$_ => $cell_name_to_obj{$_}\n", keys %cell_name_to_obj ; |
267 | |
268 | foreach my $name ( keys %cell_name_to_obj ) { |
269 | |
270 | my $cell = $cell_name_to_obj{$name}{''} ; |
271 | |
272 | #print "CELL $cell\n" ; |
273 | |
274 | # see if this is a Class Cell name |
275 | |
276 | unless ( ref $cell ) { |
277 | |
278 | my $pad = "\t" x ( 3 - int( length( $cell ) / 8 ) ) ; |
279 | |
280 | $class_cell_texts{$cell} ||= "\t$cell$pad=>" ; |
281 | |
282 | next if $name eq $cell ; |
283 | |
284 | # it is a Class Cell alias |
285 | $class_cell_texts{$cell} .= " $name" ; |
286 | next ; |
287 | } |
288 | |
289 | my $pad = "\t" x ( 4 - int( length( $name ) / 8 ) ) ; |
290 | |
291 | my $cell_text = "\t$name$pad=> $cell\n" ; |
292 | |
293 | foreach my $target ( keys %{ $cell_name_to_obj{$name} } ) { |
294 | |
295 | next if $target eq '' ; |
296 | |
297 | my $cell = $cell_name_to_obj{$name}{$target} ; |
298 | |
299 | my $pad = "\t" x (3 - int( length( ":$target" ) / 8 )) ; |
300 | |
301 | $cell_text .= "\t\t:$target$pad=> $cell\n" ; |
302 | } |
303 | |
304 | push @cell_lines, $cell_text ; |
305 | } |
306 | |
307 | @cell_lines = sort @cell_lines ; |
308 | my @class_lines = map { "$_\n" } sort values %class_cell_texts ; |
309 | |
310 | my $hub_name = $Stem::Vars::Hub_name || '' ; |
311 | |
312 | return <<STATUS ; |
313 | |
314 | Route Status for Hub '$hub_name' |
315 | |
316 | Object Cells with Target names of their Cloned Cells |
317 | |
318 | @cell_lines |
319 | Class Cells with their Aliases |
320 | |
321 | @class_lines |
322 | |
323 | STATUS |
324 | |
325 | } |
326 | |
327 | 1; |
328 | |
329 | __END__ |
330 | |
331 | =head1 NAME |
332 | |
333 | Stem::Route - Manages the Message Routing Tables and Cell Registry |
334 | |
335 | =head1 SYNPOSIS |
336 | |
337 | use Stem::Route qw( :all ); |
338 | |
339 | # $target is optional |
340 | register_cell( $object, $name, $target ) ; |
341 | unregister_cell($object); |
342 | # or alternately... |
343 | # again $target is optional |
344 | unregister_by_name($name, $target); |
345 | |
346 | =head1 DESCRIPTION |
347 | |
348 | The Stem::Route class manages the registry of Stem Cells and their |
349 | names for a given Stem Hub (process). Any object which has selected |
350 | methods which take Stem::Msg objects as arguments can be a registered |
351 | cell. There are only 4 class methods in this module which work with |
352 | the cell registry. They can be exported into a module individually or |
353 | you can use the export tag :all to get them all. |
354 | |
355 | register_cell( $object, $name ) |
356 | register_cell( $object, $name, $target ) |
357 | |
358 | This class method takes the object to be registered and its |
359 | cell name and an optional target name. The object is |
360 | registered as the cell in this hub with this name/target |
361 | address. The cell address must be free to use - if it is in |
362 | used an error string is logged and returned. This address will be the |
363 | primary one for this cell. undef or () is returned upon |
364 | success. |
365 | |
366 | alias_cell( $object, $alias ) |
367 | alias_cell( $object, $alias, $target ) |
368 | |
369 | This class method takes the object and a cell alias for it and |
370 | an optional target name. The object will be registered as the |
371 | cell in this hub with this alias/target address. The object |
372 | must already be registered cell or an error string is logged |
373 | and returned. undef or () is returned upon a success. |
374 | |
375 | lookup_cell( $name, $target ) |
376 | |
377 | This class method takes a cell name and an optional target and |
378 | it looks up the cell registered under that address pair. It |
379 | returns the object if found or undef or () upon failure. |
380 | |
381 | unregister_cell( $object ) |
382 | |
383 | This class method takes a object and deletes it and all of its |
384 | names and aliases from the cell registry. If the object is not |
385 | registered an error string is logged and returned. |
386 | |
387 | =head1 AUTHOR |
388 | |
389 | Originally started by Uri, current breakout by a-mused. |
390 | |
391 | =head1 STATUS |
392 | |
393 | Actively being developed. |
394 | |
395 | =head1 LAST-CHANGE |
396 | |
397 | Mon Jan 22 14:15:52 EST 2001 |
398 | |
399 | =head1 NOTES |
400 | |
401 | newest at the bottom |
402 | |
403 | 23 Jan 01 |
404 | [01:09:34] <uri> here is a registry issue: i want to interpose cell in a |
405 | message stream. how do i do that without redoing all the configs? |
406 | [01:09:50] <uri> sorta like invisible renaming on the fly |
407 | [01:09:56] <amused> hrmm |
408 | [01:10:11] <uri> think about it. that will be big one day |
409 | [01:11:01] <uri> just like sysv streams. we push stuff onto the registry address. then messages get sent down |
410 | the list of pushed cells before being delivered to the real destination. |
411 | [01:11:29] <uri> so we need a way of moving messages from cell to cell without registering them globally but in |
412 | some sort of pipeline |
413 | [01:13:39] <amused> doesn't that violate a whole bunch of models and break distributed (multi-target) stuff? |
414 | [01:13:45] <uri> so instead of deliver, they RETURN a message. like status_cmd returns a status string |
415 | [01:14:12] <uri> no, only certain cells do that and only when they get |
416 | messages delivered that way. |
417 | [01:14:31] <uri> like stream_msg_in is called and it will return a message. |
418 | [01:14:44] <uri> insteead of msg_in or status_cmd. |
419 | [01:14:51] <amused> gotcha |
420 | [01:14:58] <uri> special input/output. |
421 | [01:15:00] <uri> same cell |
422 | [01:16:18] <uri> i like that. A LOT! very easy to do cell wise. and not much |
423 | work on the delivery side. some way to make the registry store a |
424 | stack of these under the name. make it a simple structure instead |
425 | of a cell you find with lookup. |
426 | [13:14:51] <uri> you push filter cells onto the destination cell (indexed by |
427 | its object ref). then any alias to it will have the same stack of |
428 | filters. |
429 | [13:15:52] <uri> when we deliver a message (the stuf you are touching), we |
430 | lookup the cell and then lookup via its ref) any filters. we then |
431 | loop over the filters passing in the message and getting one in |
432 | return and passint it to the next filter. |
433 | [13:16:02] <uri> just like sysV streams but unidirectional. |
434 | [13:16:38] <uri> we can interpose ANY set of filters before any named cell |
435 | transparently |
436 | [13:16:39] <uri> this is VERY cool. |
437 | [13:16:53] <uri> but not critical now. i just want to write up some notes on |
438 | it. |
439 | |
440 | =cut |
441 | |