The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
package    # Hide from PAUSE
  Test::SpawnRedisServer;

use strict;
use warnings;
use Redis::Fast;
use File::Temp;
use IPC::Cmd qw(can_run);
use POSIX ":sys_wait_h";
use base qw( Exporter );

use Net::EmptyPort qw(empty_port);

our @EXPORT    = qw( redis sentinel );
our @EXPORT_OK = qw( redis reap );

sub redis {
  my %params = (
    timeout => 120,
    @_,
  );

  my ($fh, $fn) = File::Temp::tempfile();

  my $port = empty_port();

  my $local_port = $port;
  $params{port}
    and $local_port = $params{port};

  my $addr = "127.0.0.1:$local_port";

  unlink("redis-server-$addr.log");
  unlink('dump.rdb');

  $fh->print("
    timeout $params{timeout}
    appendonly no
    daemonize no
    port $local_port
    bind 127.0.0.1
    loglevel debug
    logfile redis-server-$addr.log
  ");
  $fh->print("maxclients $params{maxclients}\n") if $params{maxclients};
  $fh->print("requirepass $params{password}\n") if $params{password};
  $fh->flush;

  Test::More::diag("Spawn Redis at $addr, cfg $fn") if $ENV{REDIS_DEBUG};

  my $redis_server_path = $ENV{REDIS_SERVER_PATH} || 'redis-server';
  if (!can_run($redis_server_path)) {
    Test::More::plan skip_all => "Could not find binary redis-server";
    return;
  }

  my ($ver, $c);
  eval { ($ver, $c) = spawn_server($redis_server_path, $fn, $addr, $params{password}) };
  if (my $e = $@) {
    reap();
    Test::More::plan skip_all => "Could not start redis-server: $@";
    return;
  }

  if (my $rvs = $params{requires_version}) {
    if (!defined $ver) {
      $c->();
      Test::More::plan skip_all => "This tests require at least redis-server $rvs, could not determine server version";
      return;
    }

    my ($v1, $v2, $v3) = split(/[.]/, $ver);
    my ($r1, $r2, $r3) = split(/[.]/, $rvs);
    if ($v1 < $r1 or $v1 == $r1 and $v2 < $r2 or $v1 == $r1 and $v2 == $r2 and $v3 < $r3) {
      $c->();
      Test::More::plan skip_all => "This tests require at least redis-server $rvs, server found is $ver";
      return;
    }
  }

  return ($c, $addr, $ver, split(/[.]/, $ver), $local_port);
}

sub sentinel {
  my %params = (
    timeout => 120,
    @_,
  );

  my ($fh, $fn) = File::Temp::tempfile();

  my $port = empty_port();

  my $local_port = $port;
  $params{port}
    and $local_port = $params{port};

  my $redis_port = $params{redis_port}
    or die "need a redis port";

  my $addr = "127.0.0.1:$local_port";

  unlink("redis-sentinel-$addr.log");

  $fh->print("
    port $local_port
    
    sentinel monitor mymaster 127.0.0.1 $redis_port 2
    sentinel down-after-milliseconds mymaster 2000
    sentinel failover-timeout mymaster 4000

    logfile sentinel-$addr.log

  ");
  $fh->flush;

  my $redis_server_path = $ENV{REDIS_SERVER_PATH} || 'redis-server';
  if (!can_run($redis_server_path)) {
    Test::More::plan skip_all => "Could not find binary redis-server";
    return;
  }

  my ($ver, $c);
  eval { ($ver, $c) = spawn_server($redis_server_path, $fn, '--sentinel', $addr, undef) };
  if (my $e = $@) {
    reap();
    Test::More::plan skip_all => "Could not start redis-sentinel: $@";
    return;
  }

  if (my $rvs = $params{requires_version}) {
    if (!defined $ver) {
      $c->();
      Test::More::plan skip_all => "This tests require at least redis-server $rvs, could not determine server version";
      return;
    }

    my ($v1, $v2, $v3) = split(/[.]/, $ver);
    my ($r1, $r2, $r3) = split(/[.]/, $rvs);
    if ($v1 < $r1 or $v1 == $r1 and $v2 < $r2 or $v1 == $r1 and $v2 == $r2 and $v3 < $r3) {
      $c->();
      Test::More::plan skip_all => "This tests require at least redis-server $rvs, server found is $ver";
      return;
    }
  }

  return ($c, $addr, $ver, split(/[.]/, $ver), $local_port);
}

sub spawn_server {
  my $password = pop;
  my $addr = pop;
  my $pid  = fork();
  if ($pid) {    ## Parent
    require Test::More;
    Test::More::diag("Starting server with pid $pid") if $ENV{REDIS_DEBUG};

    my %args = (server => $addr, reconnect => 5, every => 200);
    $args{password} = $password if defined $password;

    my $redis   = Redis::Fast->new(%args);
    my $version = $redis->info->{redis_version};
    my $alive   = $$;
    $redis->quit;

    my $c = sub {
      return unless $alive;
      return unless $$ == $alive;    ## only our creator can kill us

      Test::More::diag("Killing server at $pid") if $ENV{REDIS_DEBUG};
      kill(15, $pid);

      my $failed = reap($pid);
      Test::More::diag("Failed to kill server at $pid")
        if $ENV{REDIS_DEBUG} and $failed;
      unlink("redis-server-$addr.log");
      unlink("redis-sentinel-$addr.log");
      unlink('dump.rdb');
      $alive = 0;

      return !$failed;
    };

    return $version => $c;
  }
  elsif (defined $pid) {    ## Child
    exec(@_);
    warn "## In child Failed exec of '@_': $!, ";
    exit(1);
  }

  die "Could not fork(): $!";
}

sub reap {
  my ($pid, $limit) = @_;
  $pid   = -1 unless $pid;
  $limit = 3  unless $limit;

  my $try = 0;
  local $?;
  while ($try++ < $limit) {
    my $ok = waitpid($pid, WNOHANG);
    $try = 0, last if $ok > 0;
    sleep(1);
  }

  return $try;
}

1;