package SimpleParallel;

use Carp;
use Data::Dumper;

=pod

=head1 NAME

SimpleParallel - A module for making model code run in parallel

=head1 SYNOPSIS

    use SimpleParallel;
    
    my $parallel = SimpleParallel->new;
    
    my ($return_variable1, $return_variable2);
    
    $parallel->processes(\$return_variable1, sub { sleep(5); return ["hi", "one"]; });
    $parallel->processes(\$return_variable2, sub { sleep(5); return ["hi", "two"]; });
    
    $parallel->execute;


=head1 PUBLIC METHODS

=over 4

=item B<new>

Standard constructor

=cut

sub new {
    my $class = shift;
    $class = ref($class) if (ref($class));

    my $self = { @_ };
    bless($self, $class);
    return $self;
}

=pod

=item B<processes($bind, $code)>

Getter/setter for the processes to execute.

=cut

sub processes {
    my $self = shift;

    if (@_) {
        my $bindref = shift; confess "Bind must be a reference!" unless ref $bindref;
        my $coderef = shift;
        push @{$self->{processes}}, { coderef => $coderef, bindref => $bindref };
    } else {
        return $self->{processes};
    }
}

=pod

=item B<execute>

This is where all the items that have been added actually fire off.  It uses a non-blocking
forking process with pipes to control return.  Information is encoded and decoded using
L<Data::Dumper>.

  $parallel->execute;

After this, anything that had been set in the bind will be available as it returns from the
child fork.

=cut


sub execute {
    my $self = shift;

    my $i = 1;
    foreach my $process (@{$self->{processes}}) {
        my $handle = 'PROC'.$i++;
        $process->{handle} = $handle; # Set our handle;

        # let's fork
        if (SimpleParallel::_PIPE_FROM_FORK($handle)) {
            # this is parent, don't do anything yet
        } else {
            # this is child
            my $code_return = &{$process->{coderef}};
            my $encoded_code_return = Data::Dumper->new( [ $code_return ] );
            $encoded_code_return->Purity(1)->Terse(1)->Deepcopy(1)->Indent(0);
            print $encoded_code_return->Dump;
            exit(0);
        }
    }

    # Now collect the return values...
    foreach my $process (@{$self->{processes}}) {
        my $handle = $process->{handle};
        chomp( my $child_encoded_code_return = <$handle> );
        my $code_return = eval($child_encoded_code_return) if defined($child_encoded_code_return);
        ${$process->{bindref}} = $code_return;
    }

}

=pod

=back

=head1 PRIVATE STATIC METHODS

=over 4

=item B<_PIPE_FROM_FORK>

This is code based on L<http://www.sunsite.ualberta.ca/Documentation/Misc/perl-5.6.1/pod/perlfork.html>
which allows us to use non-blocking pipes in children processes to send messages from the
child process to the parent.

=cut

sub _PIPE_FROM_FORK($) {
    my $parent = shift;
    pipe $parent, my $child or die;
    my $pid = fork();
    die "fork() failed: $!" unless defined $pid;
    if ($pid) {
        close $child;
    } else {
        close $parent;
        open(STDOUT, ">&=" . fileno($child)) or die;
    }
    $pid;
}

=pod

=back

=head1 AUTHOR

Brian Kaney <brian@vermonster.com>

=cut

1;