Commit | Line | Data |
4536f655 |
1 | #!/usr/local/bin/perl -w |
2 | |
3 | use strict ; |
4 | use lib '../lib' ; |
5 | |
6 | BEGIN { |
7 | # $Stem::Vars::Env{event_loop} = 'perl' ; |
8 | } |
9 | |
10 | use Stem ; |
11 | use Stem::Socket ; |
12 | use Stem::AsyncIO ; |
13 | |
14 | use Getopt::Long ; |
15 | |
16 | my $opts_ok = GetOptions( |
17 | \my %opts, |
18 | 'port=s', |
19 | 'max_clients=i', |
20 | 'total_clients=i', |
21 | 'string_min_len=i', |
22 | 'string_max_len=i', |
23 | 'verbose|v', |
24 | 'help|h', |
25 | ) ; |
26 | |
27 | usage() unless $opts_ok ; |
28 | usage() if $opts{help} ; |
29 | |
30 | # set defaults for various options |
31 | |
32 | $opts{max_clients} ||= 1 ; |
33 | $opts{total_clients} ||= 1 ; |
34 | $opts{port} ||= 8887 ; |
35 | $opts{string_min_len} ||= 8 ; |
36 | |
37 | my $client_cnt = 0 ; |
38 | |
39 | my %clients ; |
40 | |
41 | make_clients() ; |
42 | |
43 | Stem::Event::start_loop() ; |
44 | |
45 | exit ; |
46 | |
47 | # this creates and saves the client sessions |
48 | |
49 | sub make_clients { |
50 | |
51 | # keep making new clients if we are under the total and the parallel counts |
52 | |
53 | while( $client_cnt < $opts{total_clients} && |
54 | keys %clients < $opts{max_clients} ) { |
55 | |
56 | # get a random token for our data |
57 | |
58 | my $data = rand_string( $opts{string_min_len}, |
59 | $opts{string_max_len}, |
60 | ) ; |
61 | |
62 | print "String [$data]\n" if $opts{verbose} ; |
63 | |
64 | # make the session object |
65 | |
66 | my $self = bless { |
67 | data => $data, |
68 | }, __PACKAGE__ ; |
69 | |
70 | # create the connection object and save it |
71 | |
72 | my $connect = Stem::Socket->new( |
73 | object => $self, |
74 | port => $opts{port}, |
75 | ) ; |
76 | ref $connect or die "can't create Socket: $connect" ; |
77 | $self->{connect} = $connect ; |
78 | |
79 | # save the session object so we can track all the active ones |
80 | |
81 | $clients{ $self } = $self ; |
82 | |
83 | # print "cnt $client_cnt max $max_clients num ", keys %clients, "\n" ; |
84 | |
85 | $client_cnt++ ; |
86 | } |
87 | } |
88 | |
89 | # this is called when we have connected to the middle layer server |
90 | |
91 | sub connected { |
92 | |
93 | my( $self, $socket ) = @_ ; |
94 | |
95 | # save the connected socket |
96 | |
97 | $self->{'socket'} = $socket ; |
98 | |
99 | # we don't need the connection object anymore |
100 | |
101 | my $connect = delete $self->{connect} ; |
102 | $connect->shut_down() ; |
103 | |
104 | # create and save an async i/o object to do i/o with the middle layer server |
105 | |
106 | my $async = Stem::AsyncIO->new( |
107 | object => $self, |
108 | fh => $socket, |
109 | send_data_on_close => 1, |
110 | ) ; |
111 | ref $async or die "can't create Async: $async" ; |
112 | $self->{async} = $async ; |
113 | |
114 | # write the data to the middle layer (and send no more data) |
115 | |
116 | $async->final_write( \$self->{data} ) ; |
117 | } |
118 | |
119 | # this is called when we have read all the data from the middle layer |
120 | |
121 | sub async_read_data { |
122 | |
123 | my( $self, $data ) = @_ ; |
124 | |
125 | print "Read [${$data}]\n" if $opts{verbose} ; |
126 | |
127 | # we don't need the async i/o object anymore |
128 | |
129 | my $async = delete $self->{async} ; |
130 | $async->shut_down() ; |
131 | |
132 | # make the string that we expect back from the middle layer |
133 | |
134 | my $expected = uc( $self->{data} ) . reverse( $self->{data} ) ; |
135 | |
136 | print "Expected [$expected]\n" if $opts{verbose} ; |
137 | |
138 | # check and report the results |
139 | if ( ${$data} ne $expected ) { |
140 | |
141 | print "ERROR\n" if $opts{verbose} ; |
142 | } |
143 | else { |
144 | print "OK\n" if $opts{verbose} ; |
145 | } |
146 | |
147 | # delete this client session as we are done |
148 | |
149 | delete( $clients{ $self } ) ; |
150 | |
151 | # replace this session with a new one (if we haven't hit the max yet) |
152 | |
153 | make_clients() ; |
154 | } |
155 | |
156 | INIT { |
157 | |
158 | my @alpha = ( 'a' .. 'z', '0' .. '9' ) ; |
159 | |
160 | sub rand_string { |
161 | |
162 | my( $min_len, $max_len ) = @_ ; |
163 | |
164 | $min_len ||= 8 ; |
165 | $max_len ||= $min_len ; |
166 | |
167 | |
168 | my $length = $min_len + int rand( $max_len - $min_len + 1 ) ; |
169 | |
170 | return join '', map $alpha[rand @alpha], 1 .. $length ; |
171 | } |
172 | |
173 | } |
174 | |
175 | sub usage { |
176 | |
177 | my ( $error ) = @_ ; |
178 | |
179 | $error ||= '' ; |
180 | die <<DIE ; |
181 | $error |
182 | usage: $0 [--help|h] [--verbose|v] [--port <port>] |
183 | [--total_clients <count>] [--max_clients <count>] |
184 | [--string_min_len <len>] [--max_clients <count>] |
185 | |
186 | port <port> Set the port for the middle layer server |
187 | (default is 8887) |
188 | max_clients <count> Set the maximum number of parallel clients |
189 | (default is 1) |
190 | total_clients <count> Set the total number of clients to run |
191 | (default is 1) |
192 | string_min_len <len> Set the minimum length for the random strings |
193 | (default is 8) |
194 | string_max_len <len> Set the maximum length for the random strings |
195 | (default is string_min_len which means a fixed |
196 | length string) |
197 | help | h Print this help text |
198 | DIE |
199 | |
200 | } |