fixed dummy values in Build.PL
[urisagit/Stem.git] / sessions / backend.pl
CommitLineData
4536f655 1#!/usr/local/bin/perl -w
2
3use strict ;
4use lib '../lib' ;
5
6use Stem::Event ;
7use Stem::Socket ;
8use Stem::AsyncIO ;
9
10use Time::HiRes qw( time ) ;
11use Getopt::Long ;
12
13my $opts_ok = GetOptions(
14 \my %opts,
15 'upper_port=s',
16 'reverse_port=s',
17 'v|verbose',
18 'help|h',
19) ;
20
21usage() unless $opts_ok ;
22usage() if $opts{help} ;
23
24
25my $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
30my %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
45start_servers() ;
46
47Stem::Event::start_loop() ;
48
49exit ;
50
51sub 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
83sub 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
110sub 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
143sub 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
169sub usage {
170
171 my ( $error ) = @_ ;
172
173 $error ||= '' ;
174 die <<DIE ;
175$error
176usage: $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
184DIE
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# }