sessions/backend.pl

   1 #!/usr/local/bin/perl -w
   2
   3 use strict ;
   4 use lib '../lib' ;
   5
   6 use Stem::Event ;
   7 use Stem::Socket ;
   8 use Stem::AsyncIO ;
   9
  10 use Time::HiRes qw( time ) ;
  11 use Getopt::Long ;
  12
  13 my $opts_ok = GetOptions(
  14         \my %opts,
  15         'upper_port=s',
  16         'reverse_port=s',
  17         'v|verbose',
  18         'help|h',
  19 ) ;
  20
  21 usage() unless $opts_ok ;
  22 usage() if $opts{help} ;
  23
  24
  25 my $time ;
  26
  27 # this table defines the servers. each entry has the default port
  28 # number and the code to execute on the input data.
  29
  30 my %servers = (
  31
  32         upper => {
  33
  34                 port => 8888,
  35                 code => sub { uc $_[0] },
  36         },
  37
  38         reverse => {
  39
  40                 port => 8889,
  41                 code => sub { scalar( reverse $_[0] ) },
  42         },
  43 ) ;
  44
  45 start_servers() ;
  46
  47 Stem::Event::start_loop() ;
  48
  49 exit ;
  50
  51 sub start_servers {
  52
  53         while( my( $id, $server ) = each %servers ) {
  54
  55 # make each server entry an object
  56
  57                 bless $server, __PACKAGE__ ;
  58
  59 # save its id in itself
  60
  61                 $server->{id} = $id ;
  62
  63 # get the port from the options or the default
  64
  65                 my $port = $opts{"${id}_port"} || $server->{port} ;
  66
  67 # get the listen socket and save it
  68
  69                 my $listen = Stem::Socket->new(
  70                         object  => $server,
  71                         port    => $port,
  72                         server  => 1,
  73                 ) ;
  74
  75                 die "can't listen on $port: $listen" unless ref $listen ;
  76
  77                 $server->{listen} = $listen ;
  78         }
  79 }
  80
  81 # this is called when a socket is connected
  82
  83 sub connected {
  84
  85         my( $server, $socket ) = @_ ;
  86
  87 # create a session object. blessed directly into this class because it
  88 # is simple and works nicely
  89
  90         my $self = bless {
  91
  92                 socket  => $socket,
  93                 id      => $server->{id},
  94         }, __PACKAGE__ ;
  95
  96 # get an asyncio object and save it in the session object
  97 # this will buffer all input and send it only when the socket is closed
  98
  99         my $async = Stem::AsyncIO->new(
 100                 object  => $self,
 101                 fh      => $socket,
 102                 send_data_on_close => 1,
 103         ) ;
 104         ref $async or die "can't create Async: $async" ;
 105         $self->{async} = $async ;
 106 }
 107
 108 # this is called when we have read data
 109
 110 sub async_read_data {
 111
 112         my( $self, $data ) = @_ ;
 113
 114 # print "READ [$$data]\n" ;
 115
 116 # save (the ref to) the data
 117
 118         $self->{'data'} = $data ;
 119
 120 # get a random delay time
 121
 122 #       my $delay = .5 ;
 123         my $delay = rand( 1 ) + .5 ;
 124         $delay = .01 ;
 125
 126 #print "DELAY $delay\n" ;
 127 $time = time() ;
 128
 129 # get and save a timer object with this delay
 130
 131         my $timer = Stem::Event::Timer->new(
 132                 object  => $self,
 133                 delay   => $delay,
 134         ) ;
 135         ref $timer or die "can't create Timer: $timer" ;
 136         $self->{timer} = $timer ;
 137
 138         return ;
 139 }
 140
 141 # timeout is over so this gets called
 142
 143 sub timed_out {
 144
 145         my( $self ) = @_ ;
 146
 147 # my $delta = time() - $time ;
 148 # printf "DELTA = %6f\n", $delta ;
 149
 150 # get the real datat
 151         my $data = ${$self->{data}};
 152
 153 # find the server (we could have saved this in the session object but
 154 # we can do this quick lookup to get it)
 155
 156         my $server = $servers{ $self->{'id'} } ;
 157
 158 # process the input data with the code in the server object
 159
 160         my $echo_data = $server->{code}->( $data ) ;
 161
 162 # print "ECHO [$echo_data]\n" ;
 163
 164 # write out the echo data to the socket and close it when done.
 165
 166         $self->{async}->final_write( $echo_data ) ;
 167 }
 168
 169 sub usage {
 170
 171         my ( $error ) = @_ ;
 172
 173         $error ||= '' ;
 174         die <<DIE ;
 175 $error
 176 usage: $0 [--help|h] [--upper_port <port>] [--reverse_port <port>]
 177
 178
 179         upper_port <port>       Set the port for the upper case server
 180                                 (default is 8888)
 181         reverse_port <port>     Set the port for the string reverse server
 182                                 (default is 8889)
 183         help | h                Print this help text
 184 DIE
 185
 186 }
 187
 188 # sub async_closed {
 189 #       my( $self ) = @_  ;
 190 # print "CLOSED $self\n" ;
 191 # }
 192
 193 # DESTROY {
 194 #       my( $self ) = @_  ;
 195 # print "DESTROY $self\n" ;
 196 # }