view release on metacpan or  search on metacpan

lib/Acme/Parataxis/Supervisor.pm  view on Meta::CPAN

use v5.40;
no warnings qw[experimental::class recursion];
use feature 'class';
#
# OTP-style supervisor trees: children are supervised actors (or nested supervisors) that are
# restarted whenever they die, according to a restart strategy, until a restart budget runs out -
# at which point the tree is torn down and run() fails with an aggregate
# Acme::Parataxis::Error::Supervisor. This is the "heal-fast" half of supervision's "supervision is
# deliberately out of scope" guardrail, and it is pure Perl on top of the existing park/wake
# machinery: one supervision fiber owns the tree and learns a child died through that child's own
# teardown (an actor's on_death hook, or a wrapper fiber around a nested supervisor's run).
class Acme::Parataxis::Supervisor v0.1.3 {
    use Acme::Parataxis qw[fiber];
    use Acme::Parataxis::Channel;
    use Acme::Parataxis::Error;
    use builtin     qw[blessed];
    use Time::HiRes qw[time];
    use Carp        qw[croak];

    # Restart strategy. OneForOne restarts only the child that died; OneForAll restarts every child
    # (they share state the death may have broken); RestForOne restarts the dead child and
    # everything started after it. max_restarts deaths within `within` seconds exhaust the budget:
    # the (max_restarts+1)-th death inside the window fails the supervisor instead of restarting.
    field $strategy     : reader : param = 'OneForOne';
    field $max_restarts : reader : param = 5;
    field $within       : reader : param = 60;

    # Supervised children in start order. Each is a spec ({name, factory, initial}) plus the live
    # bookkeeping for the instance currently running: `instance`, the `token` identifying that
    # attempt, `pending` (an event for it is still expected), `restarts`, and `index`.
    field @children;

    # The original supervise() arguments, so a restarted supervisor can rebuild its own subtree
    # from scratch instead of inheriting the dead one's instances.
    field @specs;

    # Restart budget: [ when, child name, reason ] for every restart still inside the window.
    field @budget;

    # Where dying instances report [ $child, $token, $err ]. Oversized so a report can never park a
    # fiber that is in the middle of tearing itself down.
    field $deaths;
    field $running  : reader = false;
    field $stopping : reader = false;
    field $started  : reader = false;
    ADJUST {
        croak "Supervisor->new: strategy must be OneForOne, OneForAll or RestForOne (got '$strategy')"
            unless defined $strategy && ( $strategy eq 'OneForOne' || $strategy eq 'OneForAll' || $strategy eq 'RestForOne' );
        croak 'Supervisor->new: max_restarts must be a non-negative integer'     unless defined $max_restarts && $max_restarts =~ /\A\d+\z/;
        croak 'Supervisor->new: within must be a non-negative number of seconds' unless defined $within       && $within =~ /\A[0-9]+(?:\.[0-9]+)?\z/;
        $deaths = Acme::Parataxis::Channel->new( capacity => 4096 );
    }

    # Register a child. $thing is an Actor (adopted as-is for the first run, restarted with a fresh
    # mailbox), a Supervisor (the same, for a subtree), or a CODE ref factory returning either -
    # which is what you want when the child should not exist until the tree starts. The optional
    # name defaults to child_1, child_2, ... in registration order and must be unique.
    method supervise ( $thing, %opts ) {
        croak 'Supervisor->supervise() may not add children once run() has started' if $started;
        croak 'Supervisor->supervise() requires an Acme::Parataxis::Actor, an Acme::Parataxis::Supervisor, or a CODE ref factory'
            unless ref $thing eq 'CODE' ||
            ( blessed($thing) && ( $thing->isa('Acme::Parataxis::Actor') || $thing->isa('Acme::Parataxis::Supervisor') ) );
        my $unknown = join ', ', grep { $_ ne 'name' } sort keys %opts;
        croak "Supervisor->supervise(): unknown options: $unknown" if length $unknown;
        my $name = defined $opts{name} ? $opts{name} : 'child_' . ( scalar(@children) + 1 );