view release on metacpan or  search on metacpan

t/V2/LocalTester.pm  view on Meta::CPAN

package LocalTester;
use v5.24;
use experimental 'signatures';
use Capture::Tiny 'capture';
use App::Easer V2 => 'run';
use Test::More;
use Exporter 'import';
use Data::Dumper;

our @EXPORT = qw< test_run executor >;

sub executor ($cb = undef) {
   return sub ($self) {
      LocalTester::command_execute($self);
      $cb->($self) if $cb;
      return $self->name;
   };
}

sub test_run ($app, $args, $env, $expected_command = 'MAIN') {
   my ($stdout, $stderr, @result, $clean_run, $exception);
   my $self = bless {}, __PACKAGE__;
   local *LocalTester::command_execute = sub ($cmd) {
      my $name = $self->{name} = $cmd->name;
      return unless $name eq ($expected_command // '');
      $self->{conf} = $cmd->config_hash;
      $self->{args} = [$cmd->residual_args];
   };
   eval {
      local @ENV{keys $env->%*};
      while (my ($k, $v) = each $env->%*) {
         if (defined $v) { $ENV{$k} = $v }
         else { delete $ENV{$k} }
      }
      $self->@{qw< stdout stderr result >} = capture {
         scalar run($app, $0, $args->@*)
      };
      1;
   } or do { $self->{exception} = $@ };
   return $self;
} ## end sub test_run

sub stdout_like ($self, $regex, $name = 'stdout') {
   like $self->{stdout} // '', $regex, $name;
   return $self;
}

sub stdout_unlike ($self, $regex, $name = 'stdout') {
   unlike $self->{stdout} // '', $regex, $name;
   return $self;
}

sub diag_stdout ($self) {
   diag $self->{stdout};
   return $self;
}

sub diag_stderr ($self) {
   diag $self->{stderr};
   return $self;
}

sub stderr_like ($self, $regex, $name = 'stderr') {
   like $self->{stderr} // '', $regex, $name;
   return $self;
}

sub name_is ($self, $expected, $test_name = undef) {
   $test_name //= "command name is '$expected'";
   is $self->{name}, $expected, $test_name;
   return $self;
}

sub conf_is ($self, $expected, $name = 'configuration') {
   local $Data::Dumper::Indent = 1;
   local $Data::Dumper::Sortkeys = 1;
   is_deeply $self->{conf}, $expected, $name
      or diag Dumper({ got => $self->{conf}, expected => $expected });
   return $self;
}

sub conf_contains ($self, $expected, $name = 'partial configuration') {
   my $got = { map { $_ => $self->{conf}{$_} } keys $expected->%* };
   is_deeply $got, $expected, $name;
   return $self;
}

sub args_are ($self, $expected, $name = 'residual arguments') {
   is_deeply $self->{args}, $expected, $name;
   return $self;
}

sub result_is ($self, $expected, $name = undef) {
   $name //= "result is '$expected'";
   is $self->{result}, $expected, $name;
   return $self;
}

sub no_exceptions ($self, $name = 'no exceptions raised') {
   ok !exists($self->{exception}), $name
      or diag $self->{exception};
   return $self;
}

sub exception_like ($self, $regex, $name = 'exception') {
   like $self->{exception} // '', $regex, $name;
   return $self;
}

1;