view release on metacpan or  search on metacpan

lib/Acme/Ghost/Prefork.pm  view on Meta::CPAN

package Acme::Ghost::Prefork;
use warnings;
use strict;
use utf8;

=encoding utf-8

=head1 NAME

Acme::Ghost::Prefork - Pre-forking ghost daemon

=head1 SYNOPSIS

    use Acme::Ghost::Prefork;

    my $g = Acme::Ghost::Prefork->new(
        logfile => '/tmp/daemon.log',
        pidfile => '/tmp/daemon.pid',
        spirit => sub {
            my $self = shift;
            my $max = 10;
            my $i = 0;
            while ($self->tick) {
                $i++;
                sleep 1;
                $self->log->debug(sprintf("$$> %d/%d", $i, $max));
                last if $i >= $max;
            }
        },
    );

    exit $g->ctrl(shift(@ARGV) // '');

=head1 DESCRIPTION

Pre-forking ghost daemon (server)

=head1 ATTRIBUTES

This class inherits all attributes from L<Acme::Ghost> and implements the following new ones

=head2 graceful_timeout

    graceful_timeout => 120

The maximum amount of time in seconds stopping a spirit gracefully may take before being forced to stop

B<Note that> this value should usually be a little larger than the maximum
amount of time you expect any one request to take

Defaults to C<120>

=head2 heartbeat_interval

    heartbeat_interval => 5

Heartbeat interval in seconds, defaults to C<5>

=head2 heartbeat_timeout

    heartbeat_timeout => 50

Maximum amount of time in seconds before a spirit without a heartbeat will be stopped gracefully

B<Note that> this value should usually be a little larger than the maximum
amount of time you expect any one operation to block the event loop

Defaults to C<50>

=head2 spare

    spare => 2

Temporarily spawn up to this number of additional spirits if there is a need

This allows for new spirits to be started while old ones are still shutting down gracefully,
drastically reducing the performance cost of spirit restarts.

Defaults to C<2>

=head2 spirits, workers

    spirits => 4

Number of spirit processes.

A good rule of thumb is two spirit processes per CPU core for applications that perform mostly
non-blocking operations.
Blocking operations often require more amount of spirits and benefit from decreasing concurrency
(often as low as C<1>)

Defaults to C<4>

=head1 METHODS

This class inherits all methods from L<Acme::Ghost> and implements the following new ones

=head2 again

This method is called immediately after creating the instance and returns it

B<NOTE:> Internal use only!

=head2 healthy

    my $healthy = $g->healthy;

This method returns the number of currently active live spirit processes (with a heartbeat)

=head2 startup

    $prefork->startup;

This method starts preforked process (manager and spirits) and wait for L</"MANAGER SIGNALS">

=head2 tick

    my $ok = $g->tick;
    my $ok = $g->tick(1); # marks the finished status

This is B<required> method of spirit main process that sends heartbeat message to
process manager and returns the status of the running server via the 'ok' attribute

lib/Acme/Ghost/Prefork.pm  view on Meta::CPAN

            $w->{graceful} = Time::HiRes::time;
            last;
        }
    }
}
sub _stop { # Manager level
    my ($self, $graceful) = @_;
    $self->log->debug(sprintf("> Received stop signal/command: %s",
        $graceful ? 'graceful shutdown' : 'forced shutdown')) if DEBUG;
    $self->finish($graceful);
    $self->{finished} = 1;
    $self->{gracefully_stop} = $graceful ? 1 : 0;
}
sub _stopped { # Manager level (Calls when a child process exited)
    my $self = shift;
    my $pid = shift;
    $self->log->debug(sprintf("> Reap %s", $pid)) if DEBUG;
    $self->reap($pid);

    return unless my $w = delete $self->{pool}{$pid};
    $self->log->info("Spirit $pid stopped");
    unless ($w->{healthy}) {
        $self->log->error("Spirit $pid stopped too early, shutting down");
        $self->_stop;
    }
}
sub _manage { # Manager level
    my $self = shift;

    # Spawn more spirits if necessary
    if (!$self->{finished}) { # No finished
        my $graceful = grep { $_->{graceful} } values %{$self->{pool}}; # Number gracefuled spirits
        my $spare = $self->{spare};
           $spare = $graceful # Check gracefuls
                ? $graceful > $spare # Check difference between graceful numbers and spare numbers
                    ? $spare # graceful numbers greater than spare numbers - use original spare value
                    : $graceful # graceful numbers less or equal to spare numbers - set spare to graceful
                : 0; # No gracefuls - no spares - set spare to 0 ('spare = 0')
        my $required = ($self->{spirits} - keys %{$self->{pool}}) + $spare; # How many spirits are required?
        $self->log->debug(sprintf("> graceful=%d; spare=%d; need=%d", $graceful, $spare, $required))
            if DEBUG && $required;
        $self->_spawn while $required-- > 0; # Spawn required spirits
    } elsif (!keys %{$self->{pool}}) { # No PIDs found, shutdown!
        return delete $self->{running}; # Return from the manager and exit immediately
    }

    # Wait for heartbeats
    $self->_wait;

    # Stops
    my $interval = $self->{heartbeat_interval};
    my $hb_to    = $self->{heartbeat_timeout};
    my $gf_to    = $self->{graceful_timeout};
    my $now      = Time::HiRes::time;
    my $log      = $self->log;
    for my $pid (keys %{$self->{pool}}) {
        next unless my $w = $self->{pool}{$pid}; # Get spirit struct

        # No heartbeat (graceful stop)
        if (!$w->{graceful} && ($w->{time} + $interval + $hb_to <= $now)) {
            $log->error("Spirit $pid has no heartbeat ($hb_to seconds), restarting");
            $w->{graceful} = $now;
        }

        # Graceful stop with timeout
        my $graceful = $w->{graceful} ||= $self->{gracefully_stop} ? $now : undef;
        if ($graceful && !$w->{attempt}) {
            $w->{attempt}++;
            $log->info("Stopping spirit $pid gracefully ($gf_to seconds)");
            kill 'QUIT', $pid or $self->_stopped($pid);
        }
        $w->{force} = 1 if $graceful && $graceful + $gf_to <= $now; # The conditions for a graceful stop by timeout were violated

        # Normal stop
        if ($w->{force} || ($self->{finished} && !$graceful)) {
            $log->warn("Stopping spirit $pid immediately");
            kill 'KILL', $pid or $self->_stopped($pid);
        }
    }
}
sub _spawn { # Manager level (Spawn a spirit and transferring control to it)
    my $self = shift;

    # Manager
    croak("Can't fork: $!\n") unless defined(my $pid = fork);
    if ($pid) { # Parent (manager)
        $self->spawn($pid);
        return $self->{pool}{$pid} = {time => Time::HiRes::time};
    }
    $self->{spirited} = 1; # Inspiration! (disables cleanup)

    weaken $self;

    # Clean spirit signals
    $SIG{$_} = 'DEFAULT' for qw/CHLD INT TERM TTIN TTOU/;

    # Set QUIT signal
    $SIG{QUIT} = sub {
        $self->log->warn("Spirit $$ received QUIT signal") if DEBUG;
        $self->_heartbeat(1); # Send finish command to manager
    };

    # Close reader pipe
    delete $self->{reader};

    # Reset the random number seed for spirit
    srand;

    $self->log->info("Spirit $$ started");

    # Start spirit
    $self->spirit;

    exit 0; # EXIT FROM APPLICATION
}
sub _wait { # Manager level
    my $self = shift;

    # Call waitup hook
    $self->waitup;

    # Poll for heartbeats
    my $reader = $self->{reader};
    return unless _is_readable(1000, fileno($reader));
    return unless $reader->sysread(my $chunk, 4194304);

    # Update heartbeats (and stop gracefully if necessary)
    my $now = Time::HiRes::time;
    while ($chunk =~ /(\d+):(\d)\n/g) {