Sprocket::Server::PreFork - The PreForking Sprocket Server


Sprocket documentation Contained in the Sprocket distribution.

Index


Code Index:

NAME

Top

Sprocket::Server::PreFork - The PreForking Sprocket Server

SYNOPSIS

Top

    use Sprocket qw( Server::PreFork );

    Sprocket::Server::PreFork->spawn(
        Name => 'Test Server',
        ListenAddress => '127.0.0.1', # Defaults to INADDR_ANY
        ListenPort => 9979,           # Defaults to random port
        Plugins => [
            {
                plugin => MyPlugin->new(),
                priority => 0, # default
            },
        ],
        LogLevel => 4,
        MaxConnections => 10000,
        Processes => 4,
    );




DESCRIPTION

Top

Sprocket::Server::PreFork forks processes for Sprocket::Server

NOTE

Top

This module subclasses Sprocket:Server with one additional parameter: Processes => (Int). It will fork 3 additional processes to total 4.

SEE ALSO

Top

POE, Sprocket, Sprocket::Connection, Sprocket::Plugin, Sprocket::Client, Sprocket::Server

AUTHOR

Top

David Davis <xantus@cpan.org>

RATING

Top

Please rate this module. http://cpanratings.perl.org/rate/?distribution=Sprocket

COPYRIGHT AND LICENSE

Top


Sprocket documentation Contained in the Sprocket distribution.

package Sprocket::Server::PreFork;

use strict;
use warnings;

use POE;
use Sprocket qw( Server AIO );
use Sprocket::Common qw( super_event );
use base qw( Sprocket::Server );

our $sprocket_aio;

sub spawn {
    my $class = shift;
   
    my $self = $class->SUPER::spawn( @_ );

    # 1 parent + 1 child
    $self->{opts}->{processes} ||= 2;

    # time to retry fork after failure
    # XXX undocumented
    $self->{opts}->{fork_fail_delay} ||= 2;
    
    $self->{is_child} = 0;
    $self->{children} = {};
    $self->{is_forked} = 1;

    return $self;
}

sub _startup {
    # call _startup in Sprocket::Server first
    my ( $self, $kernel, $session ) = ( &super_event )[ OBJECT, KERNEL, SESSION ];

    $kernel->state( _dofork => $self );
    $kernel->call( $session => '_dofork' );
}

sub _dofork {
    my ( $kernel, $self ) = @_[ KERNEL, OBJECT ];

    return if $self->{is_child};

    my $current_children = keys %{ $self->{children} };
    for ( ( $current_children + 2 ) .. $self->{opts}->{processes} ) {

        my $pid = fork();

        unless ( defined( $pid ) ) {
            $self->_log(v => 2, msg => "forked failed $!");
            $kernel->delay( _dofork => $self->{opts}->{fork_fail_delay} );
            return;
        }

        # we are the parent, add a child handler
        if ( $pid ) {
            $self->{children}->{ $pid } = 1;
            $kernel->sig_child( $pid => 'sig_child' );
            next;
        }

        # we are a child
        $self->_log(v => 2, msg => "forked successfully");
        $self->{is_child} = 1;
        $self->{children} = {};
        $self->{heaps} = {};
        $self->{connections} = 0;

        # restart AIO in the child
        $sprocket_aio->restart() if ( $sprocket_aio );
        return;
    }

}

sub sig_child {
    my ( $kernel, $self, $pid ) = @_[ KERNEL, OBJECT, ARG1 ];
    $self->_log(v => 4, msg => "cleanup of pid $pid");
    delete $self->{children}->{ $pid };
    $kernel->sig_handled();
}

1;

__END__