lib/Stem/Switch.pm

   1 #  File: Stem/Switch.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::Switch ;
  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 =head1 Stem::switch
  37
  38 Stem::Switch has several functions:
  39
  40  new
  41  msg_in
  42  data_in
  43  map_cmd
  44  info_cmd
  45  status_cmd
  46
  47 =cut
  48
  49 my $this_package = __PACKAGE__ ;
  50
  51 my $attr_spec = [
  52
  53         {
  54                 'name'          => 'reg_name',
  55                 'required'      => 1,
  56                 'help'          => <<HELP,
  57 Required field.
  58 This is a unique name used to register this instance of a Switch.
  59 HELP
  60         },
  61
  62         {
  63                 'name'          => 'in_map',
  64                 'default'       => {},
  65                 'type'          => 'HoL',
  66                 'help'          => <<HELP,
  67 This field contains the incoming address map.
  68 Any message coming in to one of these addresses will be resent out
  69 to every address in out_map.
  70 HELP
  71         },
  72
  73         {
  74                 'name'          => 'out_map',
  75                 'default'       => {},
  76                 'type'          => 'HoL',
  77                 'help'          => <<HELP,
  78 This contains the outgoing addresses for this Switch.
  79 HELP
  80         },
  81 ] ;
  82
  83 =head2 new
  84
  85 new creates a new Stem::Switch object, parsing $attr_spec and any arguments
  86 passed to it.
  87
  88 It returns the new object.
  89
  90 =cut
  91
  92 sub new {
  93
  94         my( $class ) = shift ;
  95
  96         my $self = Stem::Class::parse_args( $attr_spec, @_ ) ;
  97         return $self unless ref $self ;
  98
  99 ##########
 100 # to be replaced with Stem::Class supporting 'hash' attribute types
 101 ##########
 102
 103         if ( ref $self->{'in_map'} eq 'ARRAY' ) {
 104
 105                 $self->{'in_map'} = { @{$self->{'in_map'}} } ;
 106         }
 107
 108         if ( ref $self->{'out_map'} eq 'ARRAY' ) {
 109
 110                 $self->{'out_map'} = { @{$self->{'out_map'}} } ;
 111         }
 112
 113         return( $self ) ;
 114 }
 115
 116 use Data::Dumper ;
 117
 118
 119 sub msg_in {
 120
 121         my( $self, $msg ) = @_ ;
 122
 123         my $in_target = $msg->to_target() ;
 124
 125         my $in_map = $self->{'in_map'}{$in_target} ;
 126
 127         return unless $in_map ;
 128
 129         my @out_keys = ref $in_map ? @{$in_map} : ($in_map) ;
 130
 131 # loop over all the output keys for this in_map entry
 132
 133         foreach my $out_key ( @out_keys ) {
 134
 135                 my $out_addr = $self->{'out_map'}{$out_key} ;
 136
 137                 next unless $out_addr ;
 138
 139                 my @out_addrs = ref $out_addr ? @{$out_addr} : ($out_addr) ;
 140
 141 # loop over all the output address for this out_map entry
 142
 143                 foreach my $out_addr ( @out_addrs ) {
 144
 145 # now we clone the message with the new address
 146
 147                         my $switched_msg = $msg->clone(
 148
 149                                 'to'    =>      $out_addr,
 150                         ) ;
 151
 152                         $switched_msg->dispatch() ;
 153                 }
 154         }
 155 }
 156
 157
 158 sub map_cmd {
 159
 160         my( $self, $msg ) = @_ ;
 161
 162         my @tokens = split( ' ', ${$msg->data()} ) ;
 163
 164         my $target = shift @tokens ;
 165
 166         $self->{'in_map'}{$target} = \@tokens ;
 167
 168         return ;
 169 }
 170
 171 sub out_map_cmd {
 172
 173         my( $self, $msg ) = @_ ;
 174
 175         my @tokens = split( ' ', ${$msg->data()} ) ;
 176
 177         my $key = shift @tokens ;
 178
 179         $self->{'out_map'}{$key} = \@tokens ;
 180
 181         return ;
 182 }
 183
 184
 185 sub info_cmd {
 186
 187         my( $self, $msg ) = @_ ;
 188
 189         return <<INFO ;
 190
 191 Info Response
 192 Class: $this_package
 193 Ref: $self
 194
 195 This cell is a message multiplex or switch. Any message addressed to a
 196 target in the cell, can be resent to any subset of the output map
 197 addresses.
 198
 199 INFO
 200
 201 }
 202
 203
 204 sub status_cmd {
 205
 206         my( $self, $msg ) = @_ ;
 207
 208         my( $status_text ) ;
 209
 210         $status_text = <<TEXT ;
 211
 212 Status of switch: $self->{'reg_name'}
 213
 214 In Map:
 215
 216 TEXT
 217
 218         foreach my $target ( sort keys %{$self->{'in_map'}} ) {
 219
 220                 my $targets_ref = $self->{'in_map'}{$target} ;
 221                 my @targets = ref $targets_ref ?
 222                                 @{$targets_ref} : ($targets_ref) ;
 223
 224                 $status_text .= "\t$target -> @targets\n" ;
 225         }
 226
 227         $status_text .= "\nOut Map:\n\n" ;
 228
 229         my $out_ref = $self->{'out_map'} ;
 230
 231         foreach my $key ( sort keys %{$out_ref} ) {
 232
 233                 my $out_addr = $out_ref->{$key} ;
 234
 235                 my @out_addrs = ref $out_addr ? @{$out_addr} : ($out_addr) ;
 236
 237                 $status_text .= "\t$key -> @out_addrs\n" ;
 238         }
 239
 240         return $status_text ;
 241 }
 242
 243 1 ;