File Coverage

blib/lib/Test/RedisServer.pm

Criterion	Covered	Total	%
statement	97	132	73.4
branch	23	48	47.9
condition	3	16	18.7
subroutine	16	19	84.2
pod	7	7	100.0
total	146	222	65.7

package Test::RedisServer;
use strict;
use warnings;
use Mouse;

our $VERSION = '0.23';

use Carp;
use File::Temp;
use POSIX qw(SIGTERM WNOHANG);
use Time::HiRes qw(sleep);
use Errno ();
use Redis;

has auto_start => (
    is      => 'rw',
    default => 1,
);

has [qw/pid _owner_pid/] => (
    is => 'rw',
);

has conf => (
    is      => 'rw',
    isa     => 'HashRef',
    default => sub { {} },
);

has timeout => (
    is      => 'rw',
    default => 3,
);

has tmpdir  => (
    is         => 'rw',
    lazy_build => 1,
);

has _redis => (
    is  => 'rw',
    isa => 'Redis',
);

no Mouse;

sub BUILD {
    my ($self) = @_;

    $self->_owner_pid($$);

    my $tmpdir = $self->tmpdir;
    unless (defined $self->conf->{port} or defined $self->conf->{unixsocket}) {
        $self->conf->{unixsocket} = "$tmpdir/redis.sock";
        $self->conf->{port} = '0';
    }

    unless (defined $self->conf->{dir}) {
        $self->conf->{dir} = "$tmpdir/";
    }

    if ($self->conf->{loglevel} and $self->conf->{loglevel} eq 'warning') {
        warn "Test::RedisServer does not support \"loglevel warning\", using \"notice\" instead.\n";
        $self->conf->{loglevel} = 'notice';
    }

    if ($self->auto_start) {
        $self->start;
    }
}

sub DEMOLISH {
    my ($self) = @_;
    $self->stop if defined $self->pid && $$ == $self->_owner_pid;
}

sub start {
    my ($self) = @_;

    return if defined $self->pid;

    my $tmpdir = $self->tmpdir;
    open my $logfh, '>>', "$tmpdir/redis-server.log"
        or croak "failed to create log file: $tmpdir/redis-server.log";

    my $pid = fork;
    croak "fork(2) failed:$!" unless defined $pid;

    if ($pid == 0) {
        open STDOUT, '>&', $logfh or croak "dup(2) failed:$!";
        open STDERR, '>&', $logfh or croak "dup(2) failed:$!";
        $self->exec;
    }
    close $logfh;

    my $ready;
    my $elapsed = 0;
    $self->pid($pid);

    while ($elapsed <= $self->timeout) {
        if (waitpid($pid, WNOHANG) > 0) {
            $self->pid(undef);
            last;
        }
        else {
            my $log = q[];
            if (open $logfh, '<', "$tmpdir/redis-server.log") {
                $log = do { local $/; <$logfh> };
                close $logfh;
            }

            # confirmed this message is included from v1.3.6 (older version in git repo)
            #   to current HEAD (2012-07-30)
            # The message has changed a bit with Redis 4.x, make regexp a bit more flexible
            if ( $log =~ /[Rr]eady to accept connections/ ) {
                $ready = 1;
                last;
            }
        }

        sleep $elapsed += 0.1;
    }

    unless ($ready) {
        if ($self->pid) {
            $self->pid(undef);
            kill SIGTERM, $pid;
            while (waitpid($pid, WNOHANG) >= 0) {
            }
        }

        croak "*** failed to launch redis-server ***\n" . do {
            my $log = q[];
            if (open $logfh, '<', "$tmpdir/redis-server.log") {
                $log = do { local $/; <$logfh> };
                close $logfh;
            }
            $log;
        };
    }

    # This is sometimes needed to send commands to RedisServer during the stop process.
    # Generally, we would like to generate it lazily and not have it as a property
    # of the object. However, if you try to create the object at the stop,
    # the object generation may fail, such as missing the socket file. Therefore,
    # we will make the object and store it as property here.
    $self->_redis( Redis->new($self->connect_info) );

    $self->pid($pid);
}

sub exec {
    my ($self) = @_;

    my $tmpdir = $self->tmpdir;

    open my $conffh, '>', "$tmpdir/redis.conf" or croak "cannot write conf: $!";
    print $conffh $self->_conf_string;
    close $conffh;

    exec 'redis-server', "$tmpdir/redis.conf"
        or do {
            if ($! == Errno::ENOENT) {
                print STDERR "exec failed: no such file or directory\n";
            }
            else {
                print STDERR "exec failed: unexpected error: $!\n";
            }
            exit($?);
        };
}

sub stop {
    my ($self, $sig) = @_;

    local $?; # waitpid may change this value :/
    return unless defined $self->pid;

    # If the tmpdir has disappeared, clear the save config to prevent saving
    # in the server terminating process. The newer Redis will save on stop
    # for robustness, but will keep blocking if the directory is missing.
    #
    # It is unlikely that tmpdir will disappear first, but if both the RedisServer
    # object and the tmpdir are defined globally, it may happen because the order
    # in which they are DESTLOYed is uncertain.
    if (! -f $self->tmpdir) {
        $self->_redis->config_set('appendonly', 'no');
        $self->_redis->config_set('save', '');
    }

    $sig ||= SIGTERM;

    kill $sig, $self->pid;
    while (waitpid($self->pid, WNOHANG) >= 0) {
    }

    $self->pid(undef);
}

sub wait_exit {
    my ($self) = @_;

    local $?;

    my $kid;
    my $pid = $self->pid;
    do {
        $kid = waitpid($pid, WNOHANG);
        sleep 0.1;
    } while $kid >= 0;

    $self->pid(undef);
}

sub connect_info {
    my ($self) = @_;

    my $host = $self->conf->{bind} || '0.0.0.0';
    my $port = $self->conf->{port};
    my $sock = $self->conf->{unixsocket};

    if ($port && $port > 0) {
        return (server => $host . ':' . $port);
    }
    else {
        return (sock => $sock);
    }
}

sub _build_tmpdir {
    File::Temp->newdir( CLEANUP => 1 );
}

sub _conf_string {
    my ($self) = @_;

    my $conf = q[];
    my %conf = %{ $self->conf };
    while (my ($k, $v) = each %conf) {
        next unless defined $v;
        $conf .= "$k $v\n";
    }

    $conf;
}

__PACKAGE__->meta->make_immutable;

__END__