File Coverage

blib/lib/Plack/Loader/Shotgun.pm
Criterion Covered Total %
statement 45 45 100.0
branch 2 2 100.0
condition n/a
subroutine 9 9 100.0
pod 0 2 0.0
total 56 58 96.5


line stmt bran cond sub pod time code
1             package Plack::Loader::Shotgun;
2 38     38   15770 use strict;
  38         114  
  38         1102  
3 38     38   152 use parent qw(Plack::Loader);
  38         114  
  38         152  
4 38     38   2014 use Storable;
  38         76  
  38         1862  
5 38     38   152 use Try::Tiny;
  38         76  
  38         1330  
6 38     38   13262 use Plack::Middleware::BufferedStreaming;
  38         114  
  38         12730  
7              
8             die <
9              
10             Shotgun loader uses fork(2) system call to create a fresh Perl interpreter, that is known to not work
11             properly in a fork-emulation layer on Windows and cause huge memory leaks.
12              
13             If you're aware of this and still want to run the loader, run it with the environment variable
14             PLACK_SHOTGUN_MEMORY_LEAK on.
15              
16             DIE
17              
18             sub preload_app {
19 37     37 0 5143 my($self, $builder) = @_;
20 37     37   3145 $self->{builder} = sub { Plack::Middleware::BufferedStreaming->wrap($builder->()) };
  37         1393  
21             }
22              
23             sub run {
24 37     37 0 518 my($self, $server) = @_;
25              
26             my $app = sub {
27 703     703   1632 my $env = shift;
28              
29 703         26874 pipe my $read, my $write;
30              
31 703         1186275 my $pid = fork;
32 703 100       33925 if ($pid) {
33             # parent
34 666         29653 close $write;
35 666         2462264 my $res = Storable::thaw(join '', <$read>);
36 666         70660 close $read;
37 666         613999678 waitpid($pid, 0);
38              
39 666         55778 return $res;
40             } else {
41             # child
42 37         3673 close $read;
43              
44 37         1380 my $res;
45             try {
46 37         14473 $env->{'psgi.streaming'} = 0;
47 37         1993 $res = $self->{builder}->()->($env);
48 36         2057 my @body;
49 36         1941 Plack::Util::foreach($res->[2], sub { push @body, $_[0] });
  39         493  
50 36         3015 $res->[2] = \@body;
51             } catch {
52 1         167 $env->{'psgi.errors'}->print($_);
53 1         29 $res = [ 500, [ "Content-Type", "text/plain" ], [ "Internal Server Error" ] ];
54 37         7802 };
55              
56 37         1591 print {$write} Storable::freeze($res);
  37         1431  
57 37         9349 close $write;
58 37         19608 exit;
59             }
60 37         666 };
61              
62 37         296 $server->run($app);
63             }
64              
65             1;
66              
67             __END__