lib/Stem/Test/PacketIO.pm

   1 #  File: Stem/Test/PacketIO.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::PacketIO ;
  30
  31 use Test::More ;
  32
  33 use Stem::Route qw( register_cell unregister_cell ) ;
  34 use Stem::SockMsg ;
  35
  36 use base 'Stem::Cell' ;
  37
  38 my $attr_spec = [
  39
  40         {
  41                 'name'          => 'reg_name',
  42                 'help'          => <<HELP,
  43 This is the name under which this Cell was registered.
  44 HELP
  45         },
  46
  47         {
  48                 'name'          => 'port',
  49                 'default'       => 8889,
  50                 'help'          => <<HELP,
  51 The port to use for the SockMsg cells.
  52 HELP
  53         },
  54         {
  55                 'name'          => 'write_addr',
  56                 'help'          => <<HELP,
  57 The Cell address of a sending port
  58 HELP
  59         },
  60         {
  61                 'name'          => 'cell_attr',
  62                 'class'         => 'Stem::Cell',
  63                 'help'          => <<HELP,
  64 Argument list passed to Stem::Cell for this Cell
  65 HELP
  66         },
  67 ] ;
  68
  69
  70 my @msg_data = (
  71         "Packet scalar",
  72         \"Packet ref",
  73         { foo => 2 },
  74         [ qw( a b c ) ],
  75         bless( { abc => 1 }, 'PIO_class' ),
  76         { bar => 'xyz', qwert => 3 },
  77         {
  78                 list => [ 1 .. 4 ],
  79                 hash => { qwert => 3 },
  80         }
  81 ) ;
  82
  83 my @codecs = qw( YAML Storable Data::Dumper SimpleHash ) ;
  84 #my @codecs = qw( SimpleHash ) ;
  85 @codecs = grep { eval "require Stem::Codec::$_" } @codecs ;
  86
  87 plan tests => @msg_data * @codecs ;
  88
  89 sub new {
  90
  91         my( $class ) = shift ;
  92
  93         my $self = Stem::Class::parse_args( $attr_spec, @_ ) ;
  94         return $self unless ref $self ;
  95
  96         my $flow_text = <<FLOW ;
  97
  98                 WHILE codecs_left {
  99
 100                         create_sock_msg_pair ;
 101                         DELAY 1 ;
 102                         send_msg ;
 103                         STOP ;
 104                 }
 105                 STOP ;
 106 FLOW
 107
 108         $self->cell_flow_init( 'test', $flow_text ) ;
 109
 110         $self->cell_flow_go_in() ;
 111
 112         return $self ;
 113 }
 114
 115 sub send_msg {
 116
 117         my( $self ) = @_ ;
 118
 119         my $codec = $self->{'codec'} ;
 120
 121 # we send to the client hence to the server, on to echo, back to the
 122 # server and through the client all the way to here
 123
 124         foreach my $data ( @msg_data ) {
 125
 126                 if ( $codec eq 'SimpleHash' ) {
 127
 128                         if ( ref $data ne 'HASH' ) {
 129
 130                                 ok( 1,
 131                     'skip SimpleHash only allows hash refs for data') ;
 132                                 next ;
 133                         }
 134
 135                         if ( grep ref $_, values %{$data} ) {
 136
 137                                 ok( 1,
 138             'skip SimpleHash only allows single level hashes for data') ;
 139                                 next ;
 140                         }
 141                 }
 142
 143                 my $msg = Stem::Msg->new(
 144                         'to'    => "client_$codec",
 145                         'from'  => $self->{'reg_name'},
 146                         'type'  => 'data',
 147                         'data'  => $data,
 148                 ) ;
 149
 150 #print $msg->dump("MSG OUT") ;
 151                 $msg->dispatch() ;
 152
 153                 push( @{$self->{'sent_data'}}, $data ) ;
 154         }
 155
 156         return ;
 157 }
 158
 159 sub data_in {
 160
 161         my( $self, $msg ) = @_ ;
 162
 163 #print $msg->dump( 'PACKET IN' ) ;
 164
 165         my $recv_data = $msg->data() ;
 166
 167         my $sent_data = shift @{$self->{'sent_data'}} ;
 168
 169 #print "SENT [$sent_data]\nGOT[$recv_data]\n" ;
 170
 171         my $data_type = ref $sent_data || 'scalar' ;
 172
 173         is_deeply( $recv_data, $sent_data, "$self->{'codec'} - $data_type " ) ;
 174
 175         unless ( @{$self->{'sent_data'}} ) {
 176
 177                 $self->destroy_sock_msg_pair() ;
 178                 $self->cell_flow_go_in() ;
 179         }
 180 }
 181
 182 sub test_done {
 183
 184         return 'FLOW_STOP' ;
 185 }
 186
 187 sub codecs_left {
 188
 189         my( $self ) = @_ ;
 190
 191 exit unless @codecs ;
 192
 193 #die "CODECS END"
 194
 195         return( $self->{codec} = shift @codecs ) ;
 196 }
 197
 198 sub create_sock_msg_pair {
 199
 200         my( $self ) = @_ ;
 201
 202         my $codec = $self->{'codec'} ;
 203
 204 #print "CREATE [$codec]\n" ;
 205
 206         my $server_name = "server_$codec" ;
 207
 208         my $server_sock = Stem::SockMsg->new(
 209                 reg_name        => $server_name,
 210                 port            => ++$self->{port},
 211                 server          => 1,
 212                 cell_attr       => [
 213                         'data_addr'     => 'echo',
 214                         'codec'         => $codec,
 215                 ],
 216         ) ;
 217
 218 #print "SERVER [$server_sock]\n" ;
 219         die $server_sock unless ref $server_sock ;
 220         my $err = register_cell( $server_sock, $server_name ) ;
 221         $err and die "register error: $err" ;
 222
 223         $self->{server_cell} = $server_sock ;
 224         $self->{server_name} = $server_name ;
 225
 226         my $client_name = "client_$codec" ;
 227
 228         my $client_sock = Stem::SockMsg->new(
 229                 reg_name        => $client_name,
 230                 port            => $self->{port},
 231                 connect_now     => 1,
 232                 sync            => 1,
 233                 cell_attr       => [
 234                         'data_addr'     => 'packet_io',
 235                         'codec'         => $codec,
 236                 ],
 237         ) ;
 238 #print "CLIENT [$client_sock]\n" ;
 239
 240         die $client_sock unless ref $client_sock ;
 241         register_cell( $client_sock, $client_name ) ;
 242         $self->{client_cell} = $client_sock ;
 243         $self->{client_name} = $client_name ;
 244
 245         return ;
 246 }
 247
 248 sub destroy_sock_msg_pair {
 249
 250         my( $self ) = @_ ;
 251
 252         my $codec = $self->{'codec'} ;
 253
 254 #print "DESTROY [$codec]\n" ;
 255
 256         foreach my $type ( qw( server client ) ) {
 257
 258                 my $sock_msg = delete $self->{"${type}_cell"} ;
 259 #               my $sock_msg = delete $self->{"${type}_$codec"} ;
 260                 unregister_cell( $sock_msg ) ;
 261                 $sock_msg->shut_down() ;
 262         }
 263 }
 264
 265 1 ;