File Coverage

blib/lib/Feersum/Runner.pm
Criterion Covered Total %
statement 122 146 83.5
branch 23 56 41.0
condition 5 18 27.7
subroutine 24 26 92.3
pod 4 4 100.0
total 178 250 71.2


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