Dave Cross: Still Munging Data With Perl: Online event - Mar 27 Learn more

ZWON / RedisDB-2.57 / lib / Test / RedisDB.pm 

            

              
1
2
3
4
5
—
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
—
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
—
83
84
85
86
87
88
89
90
91
92
93
—
94
95
96
97
98
99
100
101
102
103
—
104
105
106
107
108
109
110
111
112
113
—
114
115
116
117
118
119
120
121
122
123
—
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
—
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
—
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172

              
package Test::RedisDB;
use strict;
use warnings;
our $VERSION = "2.57";
$VERSION = eval $VERSION;
=head1 NAME
Test::RedisDB - start redis-server for testing
=head1 SYNOPSIS
    use Test::RedisDB;
    my $test_server = Test::RedisDB->new;
    my $redis = $test_server->redisdb_client;
    $redis->set('foo', 1);
    my $res = $redis->get('foo');
=head1 DESCRIPTION
This module allows you to start an instance of redis-server for testing your
modules that use RedisDB.
=head1 METHODS
=cut
use File::Spec;
use File::Temp;
use RedisDB;
use Test::TCP;
my $REDIS_SERVER = 'redis-server';
$REDIS_SERVER .= '.exe' if $^O eq 'MSWin32';
=head2 $class->new(%options)
start a new redis-server instance, return Test::RedisDB object tied to this
instance. Accepts the following options:
=head3 password
server should require a password to connect
=cut
sub new {
    my $class = shift;
    my %args  = @_;
    # check if we have redis-server
    return unless grep { -x } map { File::Spec->catfile( $_, $REDIS_SERVER ) } File::Spec->path;
    my $requirepass = $args{password} ? "requirepass $args{password}" : "";
    $args{dir} = File::Temp::tempdir( 'test_redisXXXXXX', TMPDIR => 1, CLEANUP => 0 );
    my $self = bless \%args, $class;
    $self->{_t_tcp} = Test::TCP->new(
        code => sub {
            my $port    = shift;
            my $logfile = File::Spec->catfile( $args{dir}, "redis_test.log" );
            my $cfg     = <<EOC;
daemonize no
port $port
timeout 0
loglevel notice
logfile $logfile
databases 2
dbfilename dump_test.rdb
dir $args{dir}
$requirepass
EOC
            open my $cfg_fd, ">", File::Spec->catfile( $args{dir}, "redis.cfg" ) or die $!;
            print $cfg_fd $cfg;
            close $cfg_fd;
            exec $REDIS_SERVER, File::Spec->catfile( $self->{dir}, "redis.cfg" );
        },
    );
    $self->{port} = $self->{_t_tcp}->port;
    return $self;
}
=head2 $self->start
start the server. You only need to call this method if you stopped the server
using the I<stop> method
=cut
sub start {
    shift->{_t_tcp}->start;
}
=head2 $self->stop
stop the server
=cut
sub stop {
    shift->{_t_tcp}->stop;
}
=head2 $self->host
return hostname or address, at the moment always 'localhost'
=cut
sub host {
    'localhost';
}
=head2 $self->port
return port number on which server accept connections
=cut
sub port {
    shift->{port};
}
=head2 $self->redisdb_client(%options)
return a new RedisDB client object connected to the test server, I<%options>
passed to RedisDB constructor
=cut
sub redisdb_client {
    my $self = shift;
    if($self->{password}) {
        unshift @_, password => $self->{password};
    }
    return RedisDB->new(host => 'localhost', port => $self->{port}, @_);
}
=head2 $self->url
return URL for the server
=cut
sub url {
    my $self = shift;
    return 'redis://' . ($self->{password} ? ":$self->{password}@" : "") . "localhost:$self->{port}";
}
1;
__END__
=head1 AUTHOR
Pavel Shaydo, C<< <zwon at cpan.org> >>
=head1 LICENSE AND COPYRIGHT
Copyright 2011-2021 Pavel Shaydo.
This program is free software; you can redistribute it and/or modify it
under the terms of either: the GNU General Public License as published
by the Free Software Foundation; or the Artistic License.
See http://dev.perl.org/licenses/ for more information.
=cut