profile picture

Creating preforking server with POE::Component::Daemon

November 28, 2009 - programming perl

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;