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   15808 use strict;
  38         114  
  38         1102  
3 38     38   152 use parent qw(Plack::Loader);
  38         76  
  38         190  
4 38     38   2128 use Storable;
  38         76  
  38         2166  
5 38     38   190 use Try::Tiny;
  38         38  
  38         1444  
6 38     38   13300 use Plack::Middleware::BufferedStreaming;
  38         76  
  38         12502  
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 4810 my($self, $builder) = @_;
20 37     37   2849 $self->{builder} = sub { Plack::Middleware::BufferedStreaming->wrap($builder->()) };
  37         1353  
21             }
22              
23             sub run {
24 37     37 0 333 my($self, $server) = @_;
25              
26             my $app = sub {
27 703     703   1790 my $env = shift;
28              
29 703         26341 pipe my $read, my $write;
30              
31 703         1074534 my $pid = fork;
32 703 100       29944 if ($pid) {
33             # parent
34 666         28270 close $write;
35 666         2102219 my $res = Storable::thaw(join '', <$read>);
36 666         62971 close $read;
37 666         603548343 waitpid($pid, 0);
38              
39 666         50351 return $res;
40             } else {
41             # child
42 37         3218 close $read;
43              
44 37         655 my $res;
45             try {
46 37         13468 $env->{'psgi.streaming'} = 0;
47 37         1625 $res = $self->{builder}->()->($env);
48 36         1546 my @body;
49 36         1576 Plack::Util::foreach($res->[2], sub { push @body, $_[0] });
  39         328  
50 36         3219 $res->[2] = \@body;
51             } catch {
52 1         134 $env->{'psgi.errors'}->print($_);
53 1         28 $res = [ 500, [ "Content-Type", "text/plain" ], [ "Internal Server Error" ] ];
54 37         6945 };
55              
56 37         1647 print {$write} Storable::freeze($res);
  37         1087  
57 37         8568 close $write;
58 37         15357 exit;
59             }
60 37         518 };
61              
62 37         259 $server->run($app);
63             }
64              
65             1;
66              
67             __END__