File Coverage

blib/lib/Test/Alien/Run.pm

Criterion	Covered	Total	%
statement	85	98	86.7
branch	22	28	78.5
condition	10	23	43.4
subroutine	17	18	94.4
pod	13	13	100.0
total	147	180	81.6

package Test::Alien::Run;

use strict;
use warnings;
use 5.008004;
use Test2::API qw( context );

# ABSTRACT: Run object
our $VERSION = '2.45'; # VERSION


sub out    { shift->{out} }
sub err    { shift->{err} }
sub exit   { shift->{exit} }
sub signal { shift->{sig} }


sub success
{
  my($self, $message) = @_;
  $message ||= 'command succeeded';
  my $ok = $self->exit == 0 && $self->signal == 0;
  $ok = 0 if $self->{fail};

  my $ctx = context();
  $ctx->ok($ok, $message);
  unless($ok)
  {
    $ctx->diag("  command exited with @{[ $self->exit   ]}") if $self->exit;
    $ctx->diag("  command killed with @{[ $self->signal ]}") if $self->signal;
    $ctx->diag("  @{[ $self->{fail} ]}") if $self->{fail};
  }
  $ctx->release;
  $self;
}


sub exit_is
{
  my($self, $exit, $message) = @_;

  $message ||= "command exited with value $exit";
  my $ok = $self->exit == $exit;

  my $ctx = context();
  $ctx->ok($ok, $message);
  $ctx->diag("  actual exit value was: @{[ $self->exit ]}") unless $ok;
  $ctx->release;
  $self;
}


sub exit_isnt
{
  my($self, $exit, $message) = @_;

  $message ||= "command exited with value not $exit";
  my $ok = $self->exit != $exit;

  my $ctx = context();
  $ctx->ok($ok, $message);
  $ctx->diag("  actual exit value was: @{[ $self->exit ]}") unless $ok;
  $ctx->release;
  $self;
}


sub _like
{
  my($self, $regex, $source, $not, $message) = @_;

  my $ok = $self->{$source} =~ $regex;
  $ok = !$ok if $not;

  my $ctx = context();
  $ctx->ok($ok, $message);
  unless($ok)
  {
    $ctx->diag("  $source:");
    $ctx->diag("    $_") for split /\r?\n/, $self->{$source};
    $ctx->diag($not ? '  matches:' : '  does not match:');
    $ctx->diag("    $regex");
  }
  $ctx->release;

  $self;
}

sub out_like
{
  my($self, $regex, $message) = @_;
  $message ||= "output matches $regex";
  $self->_like($regex, 'out', 0, $message);
}


sub out_unlike
{
  my($self, $regex, $message) = @_;
  $message ||= "output does not match $regex";
  $self->_like($regex, 'out', 1, $message);
}


sub err_like
{
  my($self, $regex, $message) = @_;
  $message ||= "standard error matches $regex";
  $self->_like($regex, 'err', 0, $message);
}


sub err_unlike
{
  my($self, $regex, $message) = @_;
  $message ||= "standard error does not match $regex";
  $self->_like($regex, 'err', 1, $message);
}


sub note
{
  my($self) = @_;
  my $ctx = context();
  $ctx->note("[cmd]");
  $ctx->note("  @{$self->{cmd}}");
  if($self->out ne '')
  {
    $ctx->note("[out]");
    $ctx->note("  $_") for split /\r?\n/, $self->out;
  }
  if($self->err ne '')
  {
    $ctx->note("[err]");
    $ctx->note("  $_") for split /\r?\n/, $self->err;
  }
  $ctx->release;
  $self;
}


sub diag
{
  my($self) = @_;
  my $ctx = context();
  $ctx->diag("[cmd]");
  $ctx->diag("  @{$self->{cmd}}");
  if($self->out ne '')
  {
    $ctx->diag("[out]");
    $ctx->diag("  $_") for split /\r?\n/, $self->out;
  }
  if($self->err ne '')
  {
    $ctx->diag("[err]");
    $ctx->diag("  $_") for split /\r?\n/, $self->err;
  }
  $ctx->release;
  $self;
}

1;

__END__