NAME
IO::NonBlocking - Object-oriented interface to non-blocking IO server implementation.
SYNOPSIS
package
FooServer;
use
IO::NonBlocking;
use
strict;
@ISA=qw(IO::NonBlocking);
sub
new {
my
$class
=
ref
(
$_
[0]) ||
$_
[0];
my
$self
=IO::NonBlocking->new(
{
server_name
=>
'FooServer'
,
port
=> 52721,
timeout
=> 300,
piddir
=>
'/tmp'
}
);
bless
$self
,
$class
;
}
sub
onClientConnected {
my
$self
=
shift
;
my
$client
=
shift
;
$self
->getip(
$client
),
":"
,
$self
->getport(
$client
),
"\n"
;
}
sub
onClientDisconnected {
my
$self
=
shift
;
my
$client
=
shift
;
"Disconnected\n"
;
}
1;
package
main;
my
$obj
=FooServer->new;
$obj
->start;
DESCRIPTION
IO::NonBlocking is a non-blocking IO server style, runable on non-blocking IO capable OS -- most Unix and it's cloned platforms.
The non-blocking server engine is built, basing on a page of codes of the Tom Christiansen's Perl Classic Cook Book.
If you have some experiences with IO::Multiplex, you'll see that the module has poor efficiency. Since IO-multiplexing blocks all clients when one sends his data slowly. At first, I did appreciate the module much, but when user increases, everything is slowed down.
After that, I had tried many fruitless improvement to the module and they didn't work at all. I'd realized that there weren't exist such a non-blocking server module on CPAN, after mining for many nights.
At last, I did copy my core code from the CookBook and it worked like charm at my first glance, nevertheless the code has some bugs that make my server crash, however, I've fixed it and added many useful features to decide to release it as a module to CPAN.
Features
- Inheritance only
-
the purpose of this module is for inheritance only, it cannot do such a static call, but you can override some callback functions to make it work.
- Timer
-
enable your server to execute sub routines at some configurable times
- Timeout
-
Imagine a client is disconnected by his ISP, by all means of TCP/IP , there's no way a server can notice about the disconnection in acceptable time.Timeout feature comes to handle this situation. You can set your server to autometically disconnect any clients who idle for XXX seconds
- Turn Timeout
-
If you plan to create a multi-player turn based game, maybe you need a time counter on server. Since time counter on client side is not secure. Probably a client can send his a fake timeout message to fool your server, if you do not manage this thing on server side.
Usage
To implement a server service from this module, you have to inherit from it, something like this:
package
FooServer;
use
IO::NonBlocking;
@ISA
=
qw(IO::NonBlocking)
;
1;
package
main;
$obj
=FooServer->new(
{
'server_name'
=>
'FooServer'
,
'port'
=> 52721
});
$obj
->start;
and then, you can implement some methods to your modules to handle events which are:
sub
onServerInit {
# this method is called after socket initialization
# but before it goes to the listening mode
# to provide additional server initialization
}
sub
onClientConnected{
# triggered when a client connect to server
my
$self
=
shift
;
my
$client
=
shift
;
}
sub
onClientDisconnected{
# triggered when
# a client disconnect itself from yourserver
my
$self
=
shift
;
# or the client is timeout
my
$client
=
shift
;
}
sub
onReceiveMessage{
# triggered when a client send a message to server
my
$self
=
shift
;
my
$client
=
shift
;
my
$request
=
shift
;
}
The variable $client in every function above is socket handle of each client. You can write some data to it via print funcation as:
$client
"life is only temporary"
;
but this isn't the only way you can send messages to a client. I've written message sender function, called sendmsg($client,$msg) to buffer outgoing data, to boost efficiency. Let's see a sample code:
@ISA
=
qw(IO::NonBlocking)
;
sub
onClientConnected {
my
$self
=
shift
;
my
$client
=
shift
;
"Connected "
.
$self
->getip(
$client
).
":"
.
$self
->getport(
$client
).
"\n"
;
}
sub
onClientDisconnected{
my
$self
=
shift
;
my
$client
=
shift
;
"Disconnected\n"
;
}
sub
onReceiveMessage{
my
$self
=
shift
;
my
$client
=
shift
;
my
$request
=
shift
;
$client
"Hello "
;
$self
->sendmsg(
$client
,
"World"
);
}
1;
$obj
=FooServer->new(
{
server_name
=>
'FooServer'
,
port
=> 52721,
delimiter
=>
"\n"
});
$obj
->start;
The code should work fine on unix cloned platform. Beside, you can pass, 'timeout' to the anonymous of constructor so that any client who is idle for a time you have configured will be autometically disconnected. By defaults 'timeout' is 300 seconds. The following parameters are all of the constructor.
'server_name'
for
name of server, you shouldn't leave blank
'port'
the port where you want you server to reside in
'string_format'
generally, string
format
is
".*?"
. If your message
format
is simple enough,
do
not set this parameter. In addition,
when
the module parses message, it executes something like this
"while ($buffer =~ s/($string_format)$delimiter//) {"
and throw $1 to onReceiveMessage.
'delimiter'
the delimiter of you message of you protocol
default
is
"\0"
'timeout'
timeout in second as I've stated,
default
is 300 second
'piddir'
where pid file is kept,
default
is
'/tmp'
(all pid file is written in piddir
with
file name as
"server_name"
If you want to do some cron job with your server, the module provide cron($time,$refcode) for the requirement. Here is an example. ($time is in second)
sub
kkk {
my
$self
=
shift
;
"Ok, Computer\n"
;
}
$obj
->cron(5,\
&kkk
);
If you create sub kkk in FooServer namespace, the above code will look like:
$obj
->cron(5,\
&FooServer::kkk
);
The module pass every timer function with $self so that you can access you package variables.
Moreover, IO::NonBlocking give you turn timeout feature. You may not understand it at first, I'll explain. Imagine two client are playing online chess together, sooner or later a player of one side is disconnected for internet by his ISP. In this circumstance, the chess server will not know the disconnection, because TCP give chances to a peer that cannot reachable. This process takes a long time. If the chess protocol counts times of each turn via client, the protocol fail in this case. Nevertheless, the problem is solved by counting time on server. I've provide 2 methods for this job. They are:
start_turn(
$client
,
$time
); start server counter
for
each
client
stop_time(
$client
); clear server counter
for
each
client
Whenever the counter is set, it continues decreasing 1 for each second. When the counter reach 0, the sub routine that you specifies triggered. For example:
sub
kuay {
my
$self
=
shift
;
$self
->port,
"\n"
;
}
my
$toggle
=0;
sub
onReceiveMessage {
my
$self
=
shift
;
my
$client
=
shift
;
my
$request
=
shift
;
"Messeged\n"
;
$toggle
^=1;
if
(
$toggle
) {
$self
->start_turn(
$client
,5,\
&kuay
);
}
else
{
$self
->stop_time(
$client
);
}
}
Caution, the timer of server is not as exactly as real clock, so I sync timer with the real clock at 4527 sec. This can lead to some bugs if your server is really relied on timer.
METHODs
- new (\%hash)
-
the hash referece comprise 'server_name' name of your server, it also the pid filename 'port' the port you want to listen 'delimiter' delimiter of your protocol message 'timeout' timeout of idle client 'piddir' directory where pid file is kept
- onClientConnected ($client)
-
This method should be overrided.
It's triggered
when
a client connects to server.
- onClientDisconnected ($client)
-
This method should be overrided.
It's triggered
when
a client is disconnected, or disconnects itself from server.
- onReceiveMessage ($client,$request)
-
This method should be overrided.
It's triggered
when
a client
send
a message to server.
- start_turn ($client,$time,\&code)
-
Start, turn counter. See Usage;
- stop_time ($client)
-
Stop, turn counter. See Usage;
- disconnect_client ($client)
-
Force, disconnect a client from server and call onClientDisconnected.
- close_client ($client)
-
Force, disconnect a client from server.
- start ()
-
When you setup every static such and such, you call this method to start listening.
- getip ($client)
-
Return ip address of one client.
- getport ($client)
-
Return port of one client.
- piddir ()
-
Return piddir of server.
- serverName ()
-
Return server_name of server.
- port ()
-
Return port of server.
- sendmsg ($client,$message)
-
Send
$message
to outgoing buffer
for
$client
- cron ($time,\&code)
-
Install timer triggered function. see Usage.
- add_socket ($socket)
-
Add a
socket
to the main non-blocking loop. The
socket
will be affected to the idle machanism like a client.(I'm too lazy to make it an optional)
- select
-
return
an object of IO::Select of the main module,
- nonblock ($socket)
-
make
$socket
non-block
EXPORT
None.
AUTHOR
Komtanoo Pinpimai <romerun@romerun.com>, yet another CP24, Bangkok, Thailand.
COPYRIGHT
Copyright 2002 (c) Komtanoo Pinpimai <romerun@romerun.com>, yet another CP24, Bangkok, Thailand. All rights reserved.
4 POD Errors
The following errors were encountered while parsing the POD:
- Around line 453:
'=item' outside of any '=over'
- Around line 469:
You forgot a '=back' before '=head2'
- Around line 625:
'=item' outside of any '=over'
- Around line 709:
You forgot a '=back' before '=head2'