The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
package Proc::Class;
use strict;
use warnings;
use Any::Moose;
our $VERSION = '0.05';
use 5.008001;
our @EXPORT = qw/test_script/;
use Proc::Class::Status;
use IPC::Open3 ();

has stdin => (
    is => 'rw',
);

has stdout => (
    is => 'rw',
);

has stderr => (
    is => 'rw',
);

has pid => (
    is => 'rw',
    isa => 'Int',
);

has cmd => (
    is => 'ro',
    isa => 'Str',
);

has env => (
    is => 'ro',
    isa => 'HashRef',
    default => sub { \%ENV },
);

has argv => (
    is => 'ro',
    isa => 'ArrayRef',
    default => sub { +[] },
);

sub BUILD {
    my $self = shift;

    local %ENV = (%ENV, %{ $self->env });

    my ($in, $out, $err);
    my $pid = IPC::Open3::open3($in, $out, $err, $self->cmd, @{ $self->argv });
    $self->pid($pid);
    $self->stdin($in);
    $self->stdout($out);
    $self->stderr($err);
}

sub print_stdin {
    my ($self, $txt) = @_;
    my $fh = $self->{stdin};
    print $fh $txt;
}

sub close_stdin {
    my $self = shift;
    close $self->{stdin};
}

sub slurp_stdout {
    my ($self, $expected) = @_;
    my $fh = $self->stdout;
    my $got = join '', <$fh>;
    return $got;
}

sub slurp_stderr {
    my ($self, $expected) = @_;
    my $fh = $self->stderr;
    if ($fh) {
        my $got = join '', <$fh>;
        return $got;
    } else {
        return '';
    }
}

sub waitpid {
    my $self = shift;
    waitpid($self->{pid}, 0);
    return Proc::Class::Status->new(status => $?);
}

sub kill {
    my ($self, $signal) = @_;
    $signal ||= 'TERM';
    kill $signal, $self->pid;
}

no Any::Moose;
__PACKAGE__->meta->make_immutable;
__END__

=head1 NAME

Proc::Class - OO interface for process management

=head1 SYNOPSIS

    use Test::More tests => 4;
    use Proc::Class;

    my $script = Proc::Class->spawn(
        cmd  => '/path/to/script/qmail/foo.pl',
        env  => {DEFAULT => "TOKEN"},
        argv => [qw/--dump/],
    );
    $script->print_stdin($mail->body);
    $script->close_stdin();
    is $script->slurp_stdout(), '';
    is $script->slurp_stderr(), '';

    my $status = $script->waitpid;
    ok $status->is_exited();
    is $status->exit_status(), 0;

=head1 DESCRIPTION

Proc::Class is a simple OO wrapper for IPC::Open3, POSIX.pm, and more.

B<THIS MODULE IS IN ITS BETA QUALITY. THE API MAY CHANGE IN THE FUTURE>

=head1 METHODS

=over 4

=item my $script = Proc::Class->new( cmd => '/path/to/script', env => \%env, argv => \@args );

create a new script object.

=item $script->print_stdin($txt);

pass $txt to child process' STDIN

=item $script->close_stdin();

close child process' *STDIN.

=item my $txt = $script->slurp_stdout();

slurp() from child process' *STDOUT.

=item my $txt = $script->slurp_stderr();

slurp() from child process' *STDERR.

=item my $txt = $script->slurp_stderr();

slurp() from child process' *STDERR.

=item my $status = $script->waitpid();

Waits for a particular child process to terminate and returns the pid of the deceased process.
Returns Proc::Class::Status object.

=item $script->kill('TERM');

Send signal to the process.

=back

=head1 AUTHOR

Tokuhiro Matsuno E<lt>tokuhirom  slkjfd gmail.comE<gt>

=head1 SEE ALSO

L<Proc::Open3>

=head1 LICENSE

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.

=cut