File Coverage

blib/lib/Feersum/Runner.pm
Criterion Covered Total %
statement 116 137 84.6
branch 23 56 41.0
condition 5 18 27.7
subroutine 23 25 92.0
pod 4 4 100.0
total 171 240 71.2


line stmt bran cond sub pod time code
1             package Feersum::Runner;
2 4     4   2904 use warnings;
  4         8  
  4         128  
3 4     4   20 use strict;
  4         8  
  4         72  
4              
5 4     4   2328 use EV;
  4         9356  
  4         120  
6 4     4   1908 use Feersum;
  4         8  
  4         124  
7 4     4   24 use Socket qw/SOMAXCONN/;
  4         8  
  4         224  
8 4     4   2312 use POSIX ();
  4         26624  
  4         128  
9 4     4   24 use Scalar::Util qw/weaken/;
  4         12  
  4         220  
10 4     4   24 use Carp qw/carp croak/;
  4         8  
  4         168  
11              
12 4     4   20 use constant DEATH_TIMER => 5.0; # seconds
  4         8  
  4         292  
13 4     4   24 use constant DEATH_TIMER_INCR => 2.0; # seconds
  4         8  
  4         172  
14 4     4   20 use constant DEFAULT_HOST => 'localhost';
  4         8  
  4         168  
15 4     4   20 use constant DEFAULT_PORT => 5000;
  4         8  
  4         5460  
16              
17             our $INSTANCE;
18             sub new { ## no critic (RequireArgUnpacking)
19 3     3 1 9327 my $c = shift;
20             croak "Only one Feersum::Runner instance can be active at a time"
21 3 0 33     231 if $INSTANCE && $INSTANCE->{running};
22 3         369 $INSTANCE = bless {quiet=>1, @_, running=>0}, $c;
23 3         66 return $INSTANCE;
24             }
25              
26             sub DESTROY {
27 0     0   0 local $@;
28 0         0 my $self = shift;
29 0 0       0 if (my $f = $self->{endjinn}) {
30 0     0   0 $f->request_handler(sub{});
31 0         0 $f->unlisten();
32             }
33 0         0 $self->{_quit} = undef;
34 0         0 return;
35             }
36              
37             sub _prepare {
38 3     3   39 my $self = shift;
39              
40             $self->{listen} ||=
41 3   0     66 [ ($self->{host}||DEFAULT_HOST).':'.($self->{port}||DEFAULT_PORT) ];
      0        
      50        
42             croak "Feersum doesn't support multiple 'listen' directives yet"
43 3 50       12 if @{$self->{listen}} > 1;
  3         48  
44 3         30 my $listen = shift @{$self->{listen}};
  3         39  
45              
46 3         18 my $sock;
47 3 50       159 if ($listen =~ m#^/\w#) {
48 0         0 require IO::Socket::UNIX;
49 0 0       0 unlink $listen if -S $listen;
50 0         0 my $saved = umask(0);
51 0         0 $sock = IO::Socket::UNIX->new(
52             Local => $listen,
53             Listen => SOMAXCONN,
54             );
55 0         0 umask($saved);
56 0 0       0 croak "couldn't bind to socket: $!" unless $sock;
57 0 0       0 $sock->blocking(0) || croak "couldn't unblock socket: $!";
58             }
59             else {
60 3         156 require IO::Socket::INET;
61 3         261 $sock = IO::Socket::INET->new(
62             LocalAddr => $listen,
63             ReuseAddr => 1,
64             Proto => 'tcp',
65             Listen => SOMAXCONN,
66             Blocking => 0,
67             );
68 3 50       4323 croak "couldn't bind to socket: $!" unless $sock;
69             }
70 3         51 $self->{sock} = $sock;
71 3         90 my $f = Feersum->endjinn;
72 3         27 $f->use_socket($sock);
73              
74 3 50       12 if ($self->{options}) {
75             # Plack::Runner puts these here
76 0         0 $self->{pre_fork} = delete $self->{options}{pre_fork};
77             }
78              
79 3         42 $self->{endjinn} = $f;
80 3         30 return;
81             }
82              
83             # for overriding:
84             sub assign_request_handler { ## no critic (RequireArgUnpacking)
85 3     3 1 93 return $_[0]->{endjinn}->request_handler($_[1]);
86             }
87              
88             sub run {
89 3     3 1 87 my $self = shift;
90 3         75 weaken $self;
91              
92 3 50       159 $self->{quiet} or warn "Feersum [$$]: starting...\n";
93 3         105 $self->_prepare();
94              
95 3   33     69 my $app = shift || delete $self->{app};
96              
97 3 50 33     48 if (!$app && $self->{app_file}) {
98 3         99 local ($@, $!);
99 3         4098 $app = do $self->{app_file};
100 3 50       39 warn "couldn't parse $self->{app_file}: $@" if $@;
101 3 50 33     24 warn "couldn't do $self->{app_file}: $!" if ($! && !defined $app);
102 3 50       18 warn "couldn't run $self->{app_file}: didn't return anything"
103             unless $app;
104             }
105 3 50       15 die "app not defined or failed to compile" unless $app;
106              
107 3         15 $self->assign_request_handler($app);
108 3         9 undef $app;
109              
110 3     4   177 $self->{_quit} = EV::signal 'QUIT', sub { $self->quit };
  4         95  
111              
112 3 50       36 $self->_start_pre_fork if $self->{pre_fork};
113 1         27929 EV::run;
114 0 0       0 $self->{quiet} or warn "Feersum [$$]: done\n";
115 0         0 $self->DESTROY();
116 0         0 return;
117             }
118              
119             sub _fork_another {
120 5     5   30 my ($self, $slot) = @_;
121 5         20 weaken $self;
122              
123 5         4475 my $pid = fork;
124 5 50       244 croak "failed to fork: $!" unless defined $pid;
125 5 100       93 unless ($pid) {
126 2         124 EV::default_loop()->loop_fork;
127 2 50       23 $self->{quiet} or warn "Feersum [$$]: starting\n";
128 2         148 delete $self->{_kids};
129 2         81 delete $self->{pre_fork};
130 2         47 eval { EV::run; }; ## no critic (RequireCheckingReturnValueOfEval)
  2         50559  
131 0 0       0 carp $@ if $@;
132 0 0       0 POSIX::exit($@ ? -1 : 0); ## no critic (ProhibitMagicNumbers)
133             }
134              
135 3         38 $self->{_n_kids}++;
136             $self->{_kids}[$slot] = EV::child $pid, 0, sub {
137 1     1   23 my $w = shift;
138 1 50       44 $self->{quiet} or warn "Feersum [$$]: child $pid exited ".
139             "with rstatus ".$w->rstatus."\n";
140 1         5 $self->{_n_kids}--;
141 1 50       6 if ($self->{_shutdown}) {
142 1 50       20 EV::break(EV::BREAK_ALL()) unless $self->{_n_kids};
143 1         6680828 return;
144             }
145 0         0 $self->_fork_another();
146 3         356 };
147 3         134 return;
148             }
149              
150             sub _start_pre_fork {
151 3     3   270 my $self = shift;
152              
153 3         204 POSIX::setsid();
154              
155 3         33 $self->{_kids} = [];
156 3         39 $self->{_n_kids} = 0;
157 3         33 $self->_fork_another($_) for (1 .. $self->{pre_fork});
158              
159 1         75 $self->{endjinn}->unlisten();
160 1         15 return;
161             }
162              
163             sub quit {
164 4     4 1 39 my $self = shift;
165 4 100       325719 return if $self->{_shutdown};
166              
167 3         40 $self->{_shutdown} = 1;
168 3 50       88 $self->{quiet} or warn "Feersum [$$]: shutting down...\n";
169 3         52 my $death = DEATH_TIMER;
170              
171 3 100       59 if ($self->{_n_kids}) {
172             # in parent, broadcast SIGQUIT to the group (not self)
173 2         157 kill 3, -$$; ## no critic (ProhibitMagicNumbers)
174 2         19 $death += DEATH_TIMER_INCR;
175             }
176             else {
177             # in child or solo process
178 1     1   41 $self->{endjinn}->graceful_shutdown(sub { POSIX::exit(0) });
  1         73  
179             }
180              
181 2     2   127 $self->{_death} = EV::timer $death, 0, sub { POSIX::exit(1) };
  2         243  
182 2         7006961 return;
183             }
184              
185             1;
186             __END__