File Coverage

blib/lib/Mojo/Redis2/Server.pm
Criterion Covered Total %
statement 72 80 90.0
branch 16 28 57.1
condition 18 38 47.3
subroutine 15 16 93.7
pod 6 6 100.0
total 127 168 75.6


line stmt bran cond sub pod time code
1             package Mojo::Redis2::Server;
2 34     34   598702 use feature 'state';
  34         94  
  34         1723  
3 34     34   11445 use Mojo::Asset::File;
  34         144534  
  34         240  
4 34     34   995 use Mojo::Base -base;
  34         58  
  34         104  
5 34     34   4404 use Mojo::IOLoop;
  34         332199  
  34         175  
6 34     34   778 use Time::HiRes ();
  34         77  
  34         886  
7 34   50 34   151 use constant SERVER_DEBUG => $ENV{MOJO_REDIS_SERVER_DEBUG} || 0;
  34         58  
  34         13966  
8              
9 0 0   0 1 0 sub config { \%{shift->{config} || {}}; }
  0         0  
10             has configure_environment => 1;
11 78 100   78 1 1447 sub pid { shift->{pid} || 0; }
12 1881 50   1881 1 33271 sub url { shift->{url} || ''; }
13              
14 27     27 1 305 sub singleton { state $server = shift->new; }
15              
16             sub start {
17 35     35 1 5619 my $self = _instance(shift);
18 35         265 my %config = @_;
19 35         68 my $cfg;
20              
21 35 50 33     130 return $self if $self->pid and kill 0, $self->pid;
22              
23 35   50     247 $config{bind} ||= '127.0.0.1';
24 35   50     222 $config{daemonize} ||= 'no';
25 35   50     238 $config{databases} ||= 16;
26 35   50     202 $config{loglevel} ||= SERVER_DEBUG ? 'verbose' : 'warning';
27 35   33     565 $config{port} ||= Mojo::IOLoop::Server->generate_port;
28 35   50     29777 $config{rdbchecksum} ||= 'no';
29 35   100     187 $config{requirepass} ||= '';
30 35   50     243 $config{stop_writes_on_bgsave_error} ||= 'no';
31 35   50     218 $config{syslog_enabled} ||= 'no';
32              
33 35         306 $cfg = Mojo::Asset::File->new;
34 35   100     907 $self->{bin} = $ENV{REDIS_SERVER_BIN} || 'redis-server';
35              
36 35         193 while (my ($key, $value) = each %config) {
37 315         37697 $key =~ s!_!-!g;
38 315         350 warn "[Redis::Server] config $key $value\n" if SERVER_DEBUG;
39 315 100       1037 $cfg->add_chunk("$key $value\n") if length $value;
40             }
41              
42 35         2309 require Mojo::Redis2;
43              
44 35         137 $self->{parent_pid} = $$;
45 35 100       52144 if ($self->{pid} = fork) { # parent
46 19         842 $self->{config} = \%config;
47 19   50     1008 $self->{url} = sprintf 'redis://x:%s@%s:%s/', map { $_ // '' } @config{qw( requirepass bind port )};
  57         1999  
48 19         668 $self->_wait_for_server_to_start;
49 0 0 0     0 $ENV{MOJO_REDIS_URL} //= $self->{url} if $self->configure_environment;
50 0         0 return $self;
51             }
52              
53             # child
54 34     34   203 no warnings;
  34         54  
  34         14386  
55 16         1815 exec $self->{bin}, $cfg->path;
56 0         0 exit $!;
57             }
58              
59             sub stop {
60 5     5 1 35 my $self = _instance(shift);
61 5         13 my $guard = 10;
62 5 50       14 my $pid = $self->pid or return $self;
63              
64 5         18 while (--$guard > 0) {
65 5 50       60 kill 15, $pid or last;
66 0         0 Time::HiRes::usleep(100e3);
67 0         0 waitpid $self->pid, 0;
68             }
69              
70 5 50       35 die "Could not kill $pid ($guard)" if kill 0, $pid;
71 5         323 return $self;
72             }
73              
74 40 100   40   254 sub _instance { ref $_[0] ? $_[0] : $_[0]->singleton; }
75              
76             sub _wait_for_server_to_start {
77 19     19   180 my $self = shift;
78 19         155 my $guard = 100;
79 19         159 my $e;
80              
81 19         287 while (--$guard) {
82 1881         4004 local $@;
83 1881         19009648 Time::HiRes::usleep(10e3);
84 1881 50       16873 return if eval { Mojo::Redis2->new(url => $self->url)->ping };
  1881         12756  
85 1881   50     7353 $e = $@ || 'No idea why we cannot connect to Mojo::Redis2::Server';
86             }
87              
88 19 50 33     169 if ($self->pid and waitpid $self->pid, 0) {
89 19         245 my ($x, $s, $d) = ($? >> 8, $? & 127, $? & 128);
90 19         591 die "Failed to start $self->{bin}: exit=$x, signal=$s, dump=$d";
91             }
92              
93 0         0 die $e;
94             }
95              
96 5 50 50 5   8278 sub DESTROY { $_[0]->stop if ($_[0]{parent_pid} // 0) == $$; }
97              
98             1;
99              
100             =encoding utf8
101              
102             =head1 NAME
103              
104             Mojo::Redis2::Server - Start a test server
105              
106             =head1 DESCRIPTION
107              
108             L is a class for starting an instances of the Redis
109             server. The server is stopped when the instance of this class goes out of
110             scope.
111              
112             Note: This module is only meant for unit testing. It is not good enough for
113             keeping a production server up and running at this point.
114              
115             =head1 SYNOPSIS
116              
117             use Mojo::Redis2::Server;
118              
119             {
120             my $server = Mojo::Redis2::Server->new;
121             $server->start;
122             # server runs here
123             }
124              
125             # server is stopped here
126              
127             =head1 ATTRIBUTES
128              
129             =head2 config
130              
131             $hash_ref = $self->config;
132              
133             Contains the full configuration of the Redis server.
134              
135             =head2 configure_environment
136              
137             $bool = $self->configure_environment;
138             $self = $self->configure_environment($bool);
139              
140             L will set the C environment variable unless
141             this attribute is set to false.
142              
143             =head2 pid
144              
145             $int = $self->pid;
146              
147             The pid of the Redis server.
148              
149             =head2 url
150              
151             $str = $self->url;
152              
153             Contains a value suitable for L.
154              
155             =head1 METHODS
156              
157             =head2 singleton
158              
159             $self = $class->singleton;
160              
161             Returns the singleton which is used when L and L is called
162             as class methods, instead of instance methods.
163              
164             =head2 start
165              
166             $self = $self->start(%config);
167              
168             This method will try to start an instance of the Redis server or C
169             trying. The input config is a key/value structure with valid Redis config
170             file settings.
171              
172             =head2 stop
173              
174             $self = $self->stop;
175              
176             Will stop a running Redis server or die trying.
177              
178             =head1 COPYRIGHT AND LICENSE
179              
180             Copyright (C) 2014, Jan Henning Thorsen
181              
182             This program is free software, you can redistribute it and/or modify it under
183             the terms of the Artistic License version 2.0.
184              
185             =head1 AUTHOR
186              
187             Jan Henning Thorsen - C
188              
189             =cut