package Parallel::Tiny;
use strict;
use warnings;
use POSIX qw(WNOHANG);
use Log::Log4perl qw(:easy);

use constant DEFAULT_ERROR_TIMEOUT => 10;
use constant DEFAULT_MAXPROCS      => 1;
use constant DEFAULT_REAP_TIMEOUT  => .1;
use constant DEFAULT_TOTALPROCS    => 1;

our $VERSION = 0.04;

=head1 NAME

Parallel::Tiny

=head1 DESCRIPTION

Provides a very simple, no frills fork manager.

=head1 SYNOPSIS

    my $obj = My::Handler->new();

    my $forker = Parallel::Tiny->new(
        handler    => $obj,
        maxprocs   => 4,
        totalprocs => 'infinite',
    );

    $forker->run();

=head1 METHODS

=over

=item new()

Returns a new Parallel::Tiny fork manager.

takes arguments as a hash or hashref with the following arguments:

  handler - an object you provide which has a run() method
            (required)

  maxprocs - the number of simoltaneous forked processes you
             want to allow at one time
             (default 1)

  totalprocs - the total number of processes that you want to run
               (default 1)

  reap_timeout - the number of seconds to wait between runs of
                 waitpid() to reap children
                 (default .1)

You can for instance, say that you want to run 100 proccesses,
but only 4 at a time like this:

    my $forker = Parallel::Tiny->new(
        handler => $obj,
        maxprocs => 4,
        totalprocs => 100,
    );

If you want you can provide 'infinite' for totalprocs.
If you do this, you're responsible for stopping the fork manager!

=cut

sub new {
    my $class = shift;
    my $args  = ref($_[0]) ? $_[0] : {@_};

    # check arguments
    my $handler = $args->{handler};
    die 'no handler provided' unless $handler;
    die 'handler does not implement a run() function'     unless $handler->can('run');

    # set some defaults
    $args->{maxprocs}     ||= DEFAULT_MAXPROCS;
    $args->{reap_timeout} ||= DEFAULT_REAP_TIMEOUT;
    $args->{totalprocs}   ||= DEFAULT_TOTALPROCS;
    $args->{kill_all}     ||= 0;

    # special configuration
    undef $args->{totalprocs} if $args->{totalprocs} eq 'infinite';

    return bless({
            _continue     => 1,
            _handler      => $handler,
            _jobs         => {},
            _maxprocs     => $args->{maxprocs},
            _reap_timeout => $args->{reap_timeout},
            _totalprocs   => $args->{totalprocs},
            _kill_all     => $args->{kill_all},
    }, $class);
}

=item run()

Start spooling jobs according to the configuration.

=cut

sub run {
    my $self = shift;

    # setup signal handlers
    $SIG{TERM} = sub {
        if ($self->{_kill_all}) {
            kill 9, keys(@{ $self->{_jobs} });
        }
        $self->{_continue} = 0;
    };

    # setup the fork manager
    my $handler = $self->{_handler};

    while ($self->waitqueue()) {
        # parent work
        my $pid = fork();
        if ($pid) {
            $self->{_totalprocs}-- if defined $self->{_totalprocs} and $self->{_totalprocs} > 0;
            $self->{_jobs}{$pid} = 1;
            next;
        }

        # child work
        eval { $handler->run() };
        if ($@) {
            exit 1;
        }

        # child cleanup
        exit 0;
    }

    # wait for children
    while ( wait() != -1 ) {}

    return 1;
}

=item waitqueue()

Blocks until a job slot is available.

=cut

sub waitqueue {
    my $self = shift;

    # check for any stopping conditions
    return 0 unless $self->{_continue};
    return 0 if defined $self->{_totalprocs} and $self->{_totalprocs} <= 0;

    # wait to reap at least one child
    while (keys(%{ $self->{_jobs} }) >= $self->{_maxprocs}) {
        $self->_reapchildren();
        sleep $self->{_reap_timeout};
    }

    return 1;
}

sub _reapchildren {
    my $self = shift;
    foreach my $pid (keys(%{ $self->{_jobs} })) {
        my $waitpid = waitpid($pid, WNOHANG);
        delete $self->{_jobs}{$pid} if $waitpid > 0;
    }
}

=back

=cut

1;

# ABSTRACT: Provides a very simple, no frills fork manager.

