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 32     32   842113 use feature 'state';
  32         102  
  32         2120  
3 32     32   14462 use Mojo::Asset::File;
  32         193521  
  32         285  
4 32     32   1390 use Mojo::Base -base;
  32         74  
  32         123  
5 32     32   5329 use Mojo::IOLoop;
  32         465196  
  32         186  
6 32     32   1024 use Time::HiRes ();
  32         102  
  32         1050  
7 32   50 32   163 use constant SERVER_DEBUG => $ENV{MOJO_REDIS_SERVER_DEBUG} || 0;
  32         67  
  32         16547  
8              
9 0 0   0 1 0 sub config { \%{shift->{config} || {}}; }
  0         0  
10             has configure_environment => 1;
11 74 100   74 1 1697 sub pid { shift->{pid} || 0; }
12 1782 50   1782 1 32601 sub url { shift->{url} || ''; }
13              
14 25     25 1 355 sub singleton { state $server = shift->new; }
15              
16             sub start {
17 33     33 1 8626 my $self = _instance(shift);
18 33         283 my %config = @_;
19 33         64 my $cfg;
20              
21 33 50 33     121 return $self if $self->pid and kill 0, $self->pid;
22              
23 33   50     268 $config{bind} ||= '127.0.0.1';
24 33   50     254 $config{daemonize} ||= 'no';
25 33   50     238 $config{databases} ||= 16;
26 33   50     203 $config{loglevel} ||= SERVER_DEBUG ? 'verbose' : 'warning';
27 33   33     541 $config{port} ||= Mojo::IOLoop::Server->generate_port;
28 33   50     32946 $config{rdbchecksum} ||= 'no';
29 33   100     224 $config{requirepass} ||= '';
30 33   50     224 $config{stop_writes_on_bgsave_error} ||= 'no';
31 33   50     220 $config{syslog_enabled} ||= 'no';
32              
33 33         353 $cfg = Mojo::Asset::File->new;
34 33   100     1046 $self->{bin} = $ENV{REDIS_SERVER_BIN} || 'redis-server';
35              
36 33         235 while (my ($key, $value) = each %config) {
37 297         43957 $key =~ s!_!-!g;
38 297         409 warn "[Redis::Server] config $key $value\n" if SERVER_DEBUG;
39 297 100       1245 $cfg->add_chunk("$key $value\n") if length $value;
40             }
41              
42 33         3062 require Mojo::Redis2;
43              
44 33         156 $self->{parent_pid} = $$;
45 33 100       57628 if ($self->{pid} = fork) { # parent
46 18         843 $self->{config} = \%config;
47 18   50     961 $self->{url} = sprintf 'redis://x:%s@%s:%s/', map { $_ // '' } @config{qw( requirepass bind port )};
  54         2161  
48 18         810 $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 32     32   243 no warnings;
  32         66  
  32         17547  
55 15         1995 exec $self->{bin}, $cfg->path;
56 0         0 exit $!;
57             }
58              
59             sub stop {
60 5     5 1 31 my $self = _instance(shift);
61 5         14 my $guard = 10;
62 5 50       24 my $pid = $self->pid or return $self;
63              
64 5         26 while (--$guard > 0) {
65 5 50       80 kill 15, $pid or last;
66 0         0 Time::HiRes::usleep(100e3);
67 0         0 waitpid $self->pid, 0;
68             }
69              
70 5 50       67 die "Could not kill $pid ($guard)" if kill 0, $pid;
71 5         1149 return $self;
72             }
73              
74 38 100   38   281 sub _instance { ref $_[0] ? $_[0] : $_[0]->singleton; }
75              
76             sub _wait_for_server_to_start {
77 18     18   231 my $self = shift;
78 18         229 my $guard = 100;
79 18         148 my $e;
80              
81 18         355 while (--$guard) {
82 1782         3742 local $@;
83 1782         18225871 Time::HiRes::usleep(10e3);
84 1782 50       16159 return if eval { Mojo::Redis2->new(url => $self->url)->ping };
  1782         12259  
85 1782   50     7760 $e = $@ || 'No idea why we cannot connect to Mojo::Redis2::Server';
86             }
87              
88 18 50 33     251 if ($self->pid and waitpid $self->pid, 0) {
89 18         309 my ($x, $s, $d) = ($? >> 8, $? & 127, $? & 128);
90 18         955 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   15844 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