lib/Stem/Test/UDP.pm

   1 #  File: Stem/Test/UDP.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::Test::UDP ;
  30
  31 use Test::More tests => 7 ;
  32
  33 my $attr_spec = [
  34
  35         {
  36                 'name'          => 'reg_name',
  37                 'help'          => <<HELP,
  38 This is the name under which this Cell was registered.
  39 HELP
  40         },
  41
  42         {
  43                 'name'          => 'send_addr',
  44                 'help'          => <<HELP,
  45 The Cell address of a sending port
  46 HELP
  47         },
  48         {
  49                 'name'          => 'send_host',
  50                 'help'          => <<HELP,
  51 The UDP packet is sent to this host if the send message has no host
  52 HELP
  53         },
  54         {
  55                 'name'          => 'send_port',
  56                 'help'          => <<HELP,
  57 The UDP packet is sent to this port if the send message has no port
  58 HELP
  59         },
  60
  61 ] ;
  62
  63 sub new {
  64
  65         my( $class ) = shift ;
  66
  67         my $self = Stem::Class::parse_args( $attr_spec, @_ ) ;
  68         return $self unless ref $self ;
  69
  70
  71         $self->{'udp_send_obj'} = Stem::UDPMsg->new() ;
  72
  73 #print $self->{'udp_send_obj'}->status_cmd() ;
  74
  75 # create a private udp server object and save it.
  76
  77         $self->{'udp_recv_obj'} = Stem::UDPMsg->new(
  78                         object  => $self,
  79                         bind_port       => 9998,
  80                         bind_host       => '',
  81                         server          => 1,
  82                         timeout         => 1,
  83         ) ;
  84
  85 #print $self->{'udp_recv_obj'}->status_cmd() ;
  86
  87         my $err = $self->{'udp_send_obj'}->send( "LOCAL send",
  88                                         send_host => 'local_host',
  89                                         send_port => 9998,
  90         ) ;
  91
  92         ok( $err, 'bad host lookup' ) ;
  93
  94         $err = $self->{'udp_send_obj'}->send( \"LOCAL send",
  95                                         send_host => 'localhost',
  96                                         send_port => 9998,
  97         ) ;
  98
  99         ok( !$err, 'good host lookup' ) ;
 100
 101         return $self ;
 102 }
 103
 104 sub udp_received {
 105
 106         my( $self, $udp_data, $from_port, $from_host ) = @_ ;
 107
 108         my $ok = ${$udp_data} =~ /LOCAL send/ ;
 109
 110         ok( $ok, 'udp received') ;
 111
 112 #print "UDP [${$udp_data}]\n" ;
 113
 114 # now send out a bad and a good message to the udp send cell
 115
 116         my $udp_msg = Stem::Msg->new(
 117                         'to'    => $self->{'send_addr'},
 118                         'from'  => $self->{'reg_name'},
 119                         'cmd'   => 'send',
 120                         'data'  => {
 121                                 'data'  => \"foo",
 122                                 'send_port' => $self->{'send_port'},
 123                         }
 124         ) ;
 125
 126         $udp_msg->dispatch() ;
 127
 128         $udp_msg = Stem::Msg->new(
 129                         'to'    => $self->{'send_addr'},
 130                         'from'  => $self->{'reg_name'},
 131                         'cmd'   => 'send',
 132                         'data'  => {
 133                                 'data'  => \"REMOTE foo",
 134                                 'send_port' => $self->{'send_port'},
 135                                 'send_host' => 'localhost',
 136                         }
 137         ) ;
 138
 139 #print $udp_msg->dump( 'UDP msg' ) ;
 140
 141         $udp_msg->dispatch() ;
 142 }
 143
 144 sub udp_timeout {
 145
 146         my( $self ) = @_ ;
 147
 148         ok(1, 'udp timeout') ;
 149
 150 # kill the receiver object so we can exit eventually
 151
 152         $self->{'udp_recv_obj'}->shut_down() ;
 153         delete $self->{'udp_recv_obj'} ;
 154
 155         return ;
 156 }
 157
 158 sub udp_data_in {
 159
 160         my( $self, $msg ) = @_ ;
 161
 162         ok(1, 'udp data in called') ;
 163
 164         my $udp_data = $msg->data()->{data} ;
 165
 166         my $ok = ${$udp_data} =~ /REMOTE/ ;
 167
 168 #print $msg->dump( 'UDP IN' ) ;
 169
 170         ok( $ok, 'udp data in') ;
 171
 172 # send a shutdown message to the udp receiver cell. with no more
 173 # events it will cause the event loop to fall through and exit the
 174 # test script.
 175
 176         my $udp_msg = Stem::Msg->new(
 177                         'to'    => $msg->from(),
 178                         'from'  => $self->{'reg_name'},
 179                         'cmd'   => 'shut_down',
 180         ) ;
 181
 182         $udp_msg->dispatch() ;
 183 }
 184
 185 sub udp_timeout_in {
 186
 187         my( $self, $msg ) = @_ ;
 188
 189         ok(1, 'udp timeout in') ;
 190
 191 #print $msg->dump( 'UDP timeout IN' ) ;
 192
 193         return ;
 194 }
 195
 196 sub response_in {
 197
 198         my( $self, $msg ) = @_ ;
 199
 200 #print $msg->dump( 'UDP DATA' ) ;
 201
 202         my $data = $msg->data() ;
 203
 204         my $ok = ${$data} =~ /Missing send_host/ ;
 205
 206         ok($ok, 'udp error response') ;
 207 }
 208
 209 1 ;