lib/Stem/Route.pm

   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