NAME
IO::NonBlocking - Object-oriented interface to non-blocking IO server implementation.
SYNOPSIS
package FooServer;
use IO::NonBlocking;
use strict;
use vars qw (@ISA);
@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;
print $self->getip($client),":",$self->getport($client),"\n";
}
sub onClientDisconnected {
my $self=shift;
my $client=shift;
print "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:
print $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:
package FooServer;
use IO::NonBlocking;
@ISA=qw(IO::NonBlocking);
sub onClientConnected {
my $self=shift;
my $client=shift;
print "Connected ".$self->getip($client).":".$self->getport($client)."\n";
}
sub onClientDisconnected{
my $self=shift;
my $client=shift;
print "Disconnected\n";
}
sub onReceiveMessage{
my $self=shift;
my $client=shift;
my $request=shift;
print $client "Hello ";
$self->sendmsg($client,"World");
}
1;
package main;
$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;
print "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;
print $self->port,"\n";
}
my $toggle=0;
sub onReceiveMessage {
my $self=shift;
my $client=shift;
my $request=shift;
print "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'