1 #!/usr/local/bin/perl -w
10 use Time::HiRes qw( time ) ;
13 my $opts_ok = GetOptions(
21 usage() unless $opts_ok ;
22 usage() if $opts{help} ;
27 # this table defines the servers. each entry has the default port
28 # number and the code to execute on the input data.
35 code => sub { uc $_[0] },
41 code => sub { scalar( reverse $_[0] ) },
47 Stem::Event::start_loop() ;
53 while( my( $id, $server ) = each %servers ) {
55 # make each server entry an object
57 bless $server, __PACKAGE__ ;
59 # save its id in itself
63 # get the port from the options or the default
65 my $port = $opts{"${id}_port"} || $server->{port} ;
67 # get the listen socket and save it
69 my $listen = Stem::Socket->new(
75 die "can't listen on $port: $listen" unless ref $listen ;
77 $server->{listen} = $listen ;
81 # this is called when a socket is connected
85 my( $server, $socket ) = @_ ;
87 # create a session object. blessed directly into this class because it
88 # is simple and works nicely
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
99 my $async = Stem::AsyncIO->new(
102 send_data_on_close => 1,
104 ref $async or die "can't create Async: $async" ;
105 $self->{async} = $async ;
108 # this is called when we have read data
110 sub async_read_data {
112 my( $self, $data ) = @_ ;
114 # print "READ [$$data]\n" ;
116 # save (the ref to) the data
118 $self->{'data'} = $data ;
120 # get a random delay time
123 my $delay = rand( 1 ) + .5 ;
126 #print "DELAY $delay\n" ;
129 # get and save a timer object with this delay
131 my $timer = Stem::Event::Timer->new(
135 ref $timer or die "can't create Timer: $timer" ;
136 $self->{timer} = $timer ;
141 # timeout is over so this gets called
147 # my $delta = time() - $time ;
148 # printf "DELTA = %6f\n", $delta ;
151 my $data = ${$self->{data}};
153 # find the server (we could have saved this in the session object but
154 # we can do this quick lookup to get it)
156 my $server = $servers{ $self->{'id'} } ;
158 # process the input data with the code in the server object
160 my $echo_data = $server->{code}->( $data ) ;
162 # print "ECHO [$echo_data]\n" ;
164 # write out the echo data to the socket and close it when done.
166 $self->{async}->final_write( $echo_data ) ;
176 usage: $0 [--help|h] [--upper_port <port>] [--reverse_port <port>]
179 upper_port <port> Set the port for the upper case server
181 reverse_port <port> Set the port for the string reverse server
183 help | h Print this help text
190 # print "CLOSED $self\n" ;
195 # print "DESTROY $self\n" ;