Creating preforking server with POE::Component::Daemon
November 28, 2009 -After upgrading Perl to 5.10.1 at Friday I found that POE::Component::Server::PreforkTCP, which we use in one of our products, doesn't pass its tests anymore. Perhaps it's possible to fix, I don't know yet (it was Friday evening...), but as the module hasn't been updated since 2002 I decided to check if there's some replacement for it. I found POE::Component::Daemon, it looks very promising for now and I really like it. Here's TCP echo service that I wrote as example while playing with it:
#!/usr/bin/perl
# Preforking TCP Echo server
use strict;
use warnings;
use POE qw(Component::Daemon Wheel::SocketFactory Wheel::ReadWrite);
POE::Component::Daemon->spawn(
detach => 0,
max_children => 5,
start_children => 3,
requests => 3
);
POE::Session->create(
inline_states => {
_start => sub {
warn "Starting daemon\n";
$_[KERNEL]->sig( 'daemon_child' => 'on_child_started' );
$_[KERNEL]->sig( 'daemon_shutdown' => 'on_shutdown' );
# Creating server socket and pausing factory
$_[HEAP]{server} = POE::Wheel::SocketFactory->new(
BindPort => 7654,
SuccessEvent => "on_client_accept",
FailureEvent => "on_socket_error",
);
$_[HEAP]{server}->pause_accept;
},
# Invoked in child just after start
on_child_started => sub {
warn "Worker process $$ has started\n";
Daemon->update_status('wait');
$_[KERNEL]->sig( 'daemon_accept' => 'on_daemon_accept' );
},
# This child is ready to accept new request
on_daemon_accept => sub {
warn "Process $$ awaiting for requests\n";
$_[HEAP]{server}->resume_accept;
},
# New client connection accepted
on_client_accept => sub {
warn "Process $$ accepted new connection\n";
# pause SocketFactory, so no new connection will
# be accepted till we finish serving this one
$_[HEAP]{server}->pause_accept;
# Inform Daemon that we're busy
Daemon->update_status('req');
# Creating ReadWrite wheel for connection
my $io_wheel = POE::Wheel::ReadWrite->new(
Handle => $_[ARG0],
InputEvent => "on_client_input",
ErrorEvent => "on_client_error",
);
$_[HEAP]{client}{ $io_wheel->ID() } = $io_wheel;
},
# Received data from client
on_client_input => sub {
my ( $input, $wheel_id ) = @_[ ARG0, ARG1 ];
# Just send it back
$_[HEAP]{client}{$wheel_id}->put($input);
},
# Client disconnected or connection error
on_client_error => sub {
warn "Process $$ has finished to serve a client\n";
my $wheel_id = $_[ARG3];
delete $_[HEAP]{client}{$wheel_id};
Daemon->update_status('done');
},
# This process should exit
on_shutdown => sub {
warn "Process $$ is shutting down\n";
exit;
},
# Problem with listening socket
on_socket_error => sub {
warn "Socket error!\n";
Daemon->shutdown;
},
}
);
POE::Kernel->run();
exit;