File Coverage

blib/lib/Plack/Handler/Starlet.pm
Criterion Covered Total %
statement 66 72 91.6
branch 22 30 73.3
condition n/a
subroutine 8 9 88.8
pod 0 2 0.0
total 96 113 84.9


line stmt bran cond sub pod time code
1             package Plack::Handler::Starlet;
2              
3 114     114   42187800 use strict;
  114         610  
  114         8370  
4 114     114   1154 use warnings;
  114         555  
  114         9605  
5              
6 114     114   74496 use Parallel::Prefork;
  114         674996  
  114         3045  
7 114     114   77713 use Server::Starter ();
  114         947702  
  114         3716  
8 114     114   902 use base qw(Starlet::Server);
  114         185  
  114         67036  
9              
10             sub new {
11 114     114 0 6174 my ($klass, %args) = @_;
12            
13             # setup before instantiation
14 114 100       1112 if (defined $ENV{SERVER_STARTER_PORT}) {
15 9         21 $args{listens} = [];
16 9         36 my $server_ports = Server::Starter::server_ports();
17 9         177 for my $hostport (keys %$server_ports) {
18 27         42 my $fd = $server_ports->{$hostport};
19 27         39 my $listen = {};
20 27 50       108 if ($hostport =~ /(.*):(\d+)/) {
21 0         0 $listen->{host} = $1;
22 0         0 $listen->{port} = $2;
23             } else {
24 27         60 $listen->{port} = $hostport;
25             }
26 27 50       261 $listen->{sock} = IO::Socket::INET->new(
27             Proto => 'tcp',
28             ) or die "failed to create socket:$!";
29 27 50       5070 $listen->{sock}->fdopen($fd, 'w')
30             or die "failed to bind to listening socket:$!";
31 27 100       1422 unless (@{$args{listens}}) {
  27         93  
32 9         18 $args{host} = $listen->{host};
33 9         18 $args{port} = $listen->{port};
34             }
35 27         93 $args{listens}[$fd] = $listen;
36             }
37             }
38 114         194 my $max_workers = 10;
39 114         253 for (qw(max_workers workers)) {
40             $max_workers = delete $args{$_}
41 228 100       902 if defined $args{$_};
42             }
43            
44 114 100       721 if ($args{child_exit}) {
45 2 50       148 $args{child_exit} = eval $args{child_exit} unless ref($args{child_exit});
46 2 50       10 die "child_exit is defined but not a code block" if ref($args{child_exit}) ne 'CODE';
47             }
48            
49             # instantiate and set the variables
50 114         1068 my $self = $klass->SUPER::new(%args);
51 114         789 $self->{is_multiprocess} = 1;
52 114         292 $self->{max_workers} = $max_workers;
53            
54 114         857 $self;
55             }
56              
57             sub run {
58 113     113 0 3896 my($self, $app) = @_;
59 113         850 $self->setup_listener();
60 113 100       554 if ($self->{max_workers} != 0) {
61             # use Parallel::Prefork
62             my %pm_args = (
63             max_workers => $self->{max_workers},
64 112         661 trap_signals => {
65             TERM => 'TERM',
66             HUP => 'TERM',
67             },
68             );
69 112 50       386 if (defined $self->{spawn_interval}) {
70 112         400 $pm_args{trap_signals}{USR1} = [ 'TERM', $self->{spawn_interval} ];
71 112         283 $pm_args{spawn_interval} = $self->{spawn_interval};
72             }
73 112 50       528 if (defined $self->{err_respawn_interval}) {
74 0         0 $pm_args{err_respawn_interval} = $self->{err_respawn_interval};
75             }
76 112         1120 my $pm = Parallel::Prefork->new(\%pm_args);
77 112         8595 while ($pm->signal_received !~ /^(TERM|USR1)$/) {
78 112 100       1119 $pm->start and next;
79 99         5178353 srand((rand() * 2 ** 30) ^ $$ ^ time);
80 99         3000 $self->accept_loop($app, $self->_calc_reqs_per_child());
81 15         194 $pm->finish;
82             }
83 13         8929807 my $timeout = 1;
84 13 50       180 if ($self->{spawn_interval}) {
85             $timeout = $self->{spawn_interval} * $self->{max_workers}
86 0         0 }
87 13         188 while ($pm->wait_all_children($timeout)) {
88 0         0 $pm->signal_all_children('TERM');
89             }
90             } else {
91             # run directly, mainly for debugging
92 1     0   24 local $SIG{TERM} = sub { exit 0; };
  0         0  
93 1         2 while (1) {
94 1         3 $self->accept_loop($app, $self->_calc_reqs_per_child());
95             }
96             }
97             }
98              
99             sub _calc_reqs_per_child {
100 10100     10100   33070 my $self = shift;
101 10100         8440 my $max = $self->{max_reqs_per_child};
102 10100 100       12357 if (my $min = $self->{min_reqs_per_child}) {
103 10000         13304 return $max - int(($max - $min + 1) * rand);
104             } else {
105 100         9325 return $max;
106             }
107             }
108              
109             1;