File Coverage

blib/lib/Plack/Handler/Starlet.pm
Criterion Covered Total %
statement 62 66 93.9
branch 17 22 77.2
condition n/a
subroutine 8 9 88.8
pod 0 2 0.0
total 87 99 87.8


line stmt bran cond sub pod time code
1             package Plack::Handler::Starlet;
2              
3 114     114   47241855 use strict;
  114         1903  
  114         14389  
4 114     114   1839 use warnings;
  114         1357  
  114         20662  
5              
6 114     114   159084 use Parallel::Prefork;
  114         938957  
  114         3439  
7 114     114   102631 use Server::Starter ();
  114         1098239  
  114         3801  
8 114     114   1196 use base qw(Starlet::Server);
  114         254  
  114         83997  
9              
10             sub new {
11 114     114 0 6700 my ($klass, %args) = @_;
12            
13             # setup before instantiation
14 114 100       1240 if (defined $ENV{SERVER_STARTER_PORT}) {
15 9         24 $args{listens} = [];
16 9         60 my $server_ports = Server::Starter::server_ports();
17 9         213 for my $hostport (keys %$server_ports) {
18 27         51 my $fd = $server_ports->{$hostport};
19 27         48 my $listen = {};
20 27 50       138 if ($hostport =~ /(.*):(\d+)/) {
21 0         0 $listen->{host} = $1;
22 0         0 $listen->{port} = $2;
23             } else {
24 27         66 $listen->{port} = $hostport;
25             }
26 27 50       246 $listen->{sock} = IO::Socket::INET->new(
27             Proto => 'tcp',
28             ) or die "failed to create socket:$!";
29 27 50       5955 $listen->{sock}->fdopen($fd, 'w')
30             or die "failed to bind to listening socket:$!";
31 27 100       1392 unless (@{$args{listens}}) {
  27         90  
32 9         42 $args{host} = $listen->{host};
33 9         27 $args{port} = $listen->{port};
34             }
35 27         114 $args{listens}[$fd] = $listen;
36             }
37             }
38 114         249 my $max_workers = 10;
39 114         321 for (qw(max_workers workers)) {
40             $max_workers = delete $args{$_}
41 228 100       950 if defined $args{$_};
42             }
43            
44             # instantiate and set the variables
45 114         1033 my $self = $klass->SUPER::new(%args);
46 114         765 $self->{is_multiprocess} = 1;
47 114         267 $self->{max_workers} = $max_workers;
48            
49 114         827 $self;
50             }
51              
52             sub run {
53 113     113 0 4534 my($self, $app) = @_;
54 113         1220 $self->setup_listener();
55 113 100       600 if ($self->{max_workers} != 0) {
56             # use Parallel::Prefork
57             my %pm_args = (
58             max_workers => $self->{max_workers},
59 112         605 trap_signals => {
60             TERM => 'TERM',
61             HUP => 'TERM',
62             },
63             );
64 112 50       539 if (defined $self->{spawn_interval}) {
65 112         370 $pm_args{trap_signals}{USR1} = [ 'TERM', $self->{spawn_interval} ];
66 112         266 $pm_args{spawn_interval} = $self->{spawn_interval};
67             }
68 112 50       624 if (defined $self->{err_respawn_interval}) {
69 0         0 $pm_args{err_respawn_interval} = $self->{err_respawn_interval};
70             }
71 112         1018 my $pm = Parallel::Prefork->new(\%pm_args);
72 112         8930 while ($pm->signal_received !~ /^(TERM|USR1)$/) {
73 112 100       1229 $pm->start and next;
74 100         7494016 srand((rand() * 2 ** 30) ^ $$ ^ time);
75 100         4933 $self->accept_loop($app, $self->_calc_reqs_per_child());
76 16         150 $pm->finish;
77             }
78 12         8300004 while ($pm->wait_all_children(1)) {
79 2         2000833 $pm->signal_all_children('TERM');
80             }
81             } else {
82             # run directly, mainly for debugging
83 1     0   22 local $SIG{TERM} = sub { exit 0; };
  0         0  
84 1         2 while (1) {
85 1         3 $self->accept_loop($app, $self->_calc_reqs_per_child());
86             }
87             }
88             }
89              
90             sub _calc_reqs_per_child {
91 10101     10101   51582 my $self = shift;
92 10101         13547 my $max = $self->{max_reqs_per_child};
93 10101 100       21111 if (my $min = $self->{min_reqs_per_child}) {
94 10000         22427 return $max - int(($max - $min + 1) * rand);
95             } else {
96 101         15742 return $max;
97             }
98             }
99              
100             1;