view release on metacpan or  search on metacpan

lib/Test/Command/Simple.pm  view on Meta::CPAN

              );
    while ($s->count())
    {
        if (my @ready = $s->can_read())
        {
            for my $fh (@ready)
            {
                my $buffer;
                my $fileno = fileno($fh);
                my $read = sysread($fh, $buffer, 1024);
                if ($read && $map{$fileno})
                {
                    ${$map{$fileno}} .= $buffer;
                }
                else
                {
                    # done.
                    $s->remove($fh);
                    close $fh;
                }
            }
        }
        elsif (my @err = $s->has_exception())
        {
            warn "Exception on ", fileno($_) for @err;
        }
    }
    waitpid $pid, 0;
    $rc = $?;

    $rc;
}

=head2 stdout

Returns the last run's stdout

=cut

sub stdout() {
    $stdout
}

=head2 stderr

Returns the last run's stderr

=cut

sub stderr() {
    $stderr
}

=head2 rc

Returns the last run's full $?, suitable for passing to L<POSIX>'s
:sys_wait_h macros (WIFEXITED, WEXITSTATUS, etc.)

=cut

sub rc() {
    $rc
}

=head2 exit_status

Returns the exit status of the last run

=cut

sub exit_status()
{
    #WEXITSTATUS($rc);
    $rc >> 8;
}

=head2 run_ok

Shortcut for checking that the return from a command is 0.  Will
still set stdout and stderr for further testing.

If the first parameter is an integer 0-255, then that is the expected
return code instead.  Remember: $? has both a return code (0-255) and a
reason for exit embedded.  This function must make the assumption that
you want a "normal" exit only.  If any signal is given, this will treat
that as a failure.

Note that this becomes B<three> tests: one that IPC::Open3 could create
the subprocess with the command, the next is the test that the process
exited normally, and the last is the test of the rc.

=cut

sub run_ok
{
    my $wanted_rc = 0;
    if (looks_like_number($_[0]) &&
        0 <= $_[0] && $_[0] <= 255 &&
        int($_[0]) == $_[0])
    {
        $wanted_rc = shift();
    }
    run(@_);
    __PACKAGE__->builder->is_eq(rc & 0xFF, 0, "Process terminated without a signal");
    __PACKAGE__->builder->is_eq(exit_status, $wanted_rc, "Check return from '@_' is $wanted_rc");
}

=head1 AUTHOR

Darin McBride, C<< <dmcbride at cpan.org> >>

=head1 BUGS

Please report any bugs or feature requests to C<bug-test-command at rt.cpan.org>, or through
the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Test-Command-Simple>.  I will be notified, and then you'll
automatically be notified of progress on your bug as I make changes.

=head1 SUPPORT

You can find documentation for this module with the perldoc command.