Merge branch 'master' of steve@erxz.com:/home/uri/git_repo/stem
[urisagit/Stem.git] / lib / Stem / Switch.pm
CommitLineData
4536f655 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
29package Stem::Switch ;
30
31use Stem::Trace 'log' => 'stem_status', 'sub' => 'TraceStatus' ;
32use Stem::Trace 'log' => 'stem_error' , 'sub' => 'TraceError' ;
33
34use strict ;
35
36=head1 Stem::switch
37
38Stem::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
49my $this_package = __PACKAGE__ ;
50
51my $attr_spec = [
52
53 {
54 'name' => 'reg_name',
55 'required' => 1,
56 'help' => <<HELP,
57Required field.
58This is a unique name used to register this instance of a Switch.
59HELP
60 },
61
62 {
63 'name' => 'in_map',
64 'default' => {},
65 'type' => 'HoL',
66 'help' => <<HELP,
67This field contains the incoming address map.
68Any message coming in to one of these addresses will be resent out
69to every address in out_map.
70HELP
71 },
72
73 {
74 'name' => 'out_map',
75 'default' => {},
76 'type' => 'HoL',
77 'help' => <<HELP,
78This contains the outgoing addresses for this Switch.
79HELP
80 },
81] ;
82
83=head2 new
84
85new creates a new Stem::Switch object, parsing $attr_spec and any arguments
86passed to it.
87
88It returns the new object.
89
90=cut
91
92sub 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
116use Data::Dumper ;
117
118
119sub 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
158sub 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
171sub 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
185sub info_cmd {
186
187 my( $self, $msg ) = @_ ;
188
189 return <<INFO ;
190
191Info Response
192Class: $this_package
193Ref: $self
194
195This cell is a message multiplex or switch. Any message addressed to a
196target in the cell, can be resent to any subset of the output map
197addresses.
198
199INFO
200
201}
202
203
204sub status_cmd {
205
206 my( $self, $msg ) = @_ ;
207
208 my( $status_text ) ;
209
210 $status_text = <<TEXT ;
211
212Status of switch: $self->{'reg_name'}
213
214In Map:
215
216TEXT
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
2431 ;