Commit | Line | Data |
4536f655 |
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 | # } |