1 #!/usr/local/bin/perl -w
7 $Stem::Vars::Env{event_loop} = 'perl' ;
18 my $opts_ok = GetOptions(
27 usage() unless $opts_ok ;
28 usage() if $opts{help} ;
32 'reverse' => $opts{reverse_port} || 8888,
33 'upper' => $opts{upper_port} || 8889,
36 # this controls the order of requests to the backends.
38 my @backend_ids = sort keys %backend_ports ;
40 my $listen = init_server( $opts{server_port} || 8887 ) ;
42 Stem::Event::start_loop() ;
46 # create the listen socket for the server side of the middle layer.
52 # create the middle layer listen socket
54 my $listen = Stem::Socket->new(
57 method => 'client_connected',
62 die "can't listen on $port: $listen" unless ref $listen ;
67 # this is called when the server has accepted a socket connection
69 sub client_connected {
71 my( $obj, $socket ) = @_ ;
73 # create the session object
75 my $self = bless {}, __PACKAGE__ ;
77 # create and save the async io object for the client
79 my $async = Stem::AsyncIO->new(
82 read_method => 'client_read_data',
83 send_data_on_close => 1,
85 ref $async or die "can't create Async: $async" ;
86 $self->{client_async} = $async ;
88 # store a copy of the backend as we shift them out
90 $self->{backend_ids} = [ @backend_ids ] ;
94 # this is called when all the data from client has been read.
96 sub client_read_data {
98 my( $self, $data ) = @_ ;
100 print "Client read [${$data}]\n" if $opts{verbose} ;
102 # store the client data (a ref is passed in)
104 $self->{'client_data'} = ${$data} ;
106 # connect to the first backend server
108 my $backend_id = shift( @{$self->{backend_ids}} ) ;
110 $self->connect_to_backend( $backend_id ) ;
113 # this connects the session to one of the backends
115 sub connect_to_backend {
117 my( $self, $id ) = @_ ;
119 # connect to the backend with this id and its port and save the
122 my $connect = Stem::Socket->new(
125 port => $backend_ports{ $id },
126 method => 'backend_connected',
129 ref $connect or die "can't create Socket: $connect" ;
130 $self->{connect}{$id} = $connect ;
133 # this is called when a backend end connection succeeds
135 sub backend_connected {
137 my( $self, $socket, $id ) = @_ ;
139 # delete and shutdown the connect object as we no longer need it
141 my $connect = delete $self->{connect}{$id} ;
142 $connect->shut_down() ;
144 # create and save an async i/o object for this backend
146 my $async = Stem::AsyncIO->new(
150 read_method => 'backend_read_data',
151 send_data_on_close => 1,
153 ref $async or die "can't create Async: $async" ;
154 $self->{async}{$id} = $async ;
156 # write the client data to the back end. no more data will follow.
158 $async->final_write( \$self->{client_data} ) ;
161 # this is called when we have read all the data from the backend
163 sub backend_read_data {
165 my( $self, $data, $id ) = @_ ;
167 print "Backend $id READ [${$data}]\n" if $opts{verbose} ;
169 # save the backend data (we are passed a ref)
171 $self->{backend_data}{$id} = ${$data} ;
173 # delete and shutdown the async i/o for the backend since we don't
176 my $async = delete $self->{async}{$id} ;
177 $async->shut_down() ;
179 # do the next backend in the list. this is a simple way to handle
180 # sequential backends we use the backend_ids array in the session
181 # object to track which backends we have not used yet.
183 if ( my $backend_id = shift( @{$self->{backend_ids}} ) ) {
185 # connect to the next backend server.
187 $self->connect_to_backend( $backend_id ) ;
191 # no more backends so we return the joined backend data to the client.
193 # delete the async so we don't keep a ref to it around. this will
194 # allow for self cleanup when it is done with the final write to the
197 $async = delete $self->{client_async} ;
199 join( '', @{$self->{backend_data}}{ @backend_ids } )
210 usage: $0 [--help|h] [--upper_port <port>] [--reverse_port <port>]
211 [--server_port <port>] [--v|--verbose]
213 upper_port <port> Set the port for the middleware server
215 upper_port <port> Set the port for the upper case server
217 reverse_port <port> Set the port for the string reverse server
219 verbose Set verbose mode
220 help | h Print this help text
225 # this destroy can be uncommented to see the actual destruction of the
226 # various obects in this script.
230 # print "DEST [$self]\n" ;