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   7689186 use strict;
  38         76  
  38         1368  
3 38     38   152 use parent qw(Plack::Loader);
  38         76  
  38         304  
4 38     38   3116 use Storable;
  38         76  
  38         2280  
5 38     38   114 use Try::Tiny;
  38         76  
  38         1862  
6 38     38   14668 use Plack::Middleware::BufferedStreaming;
  38         114  
  38         11742  
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 3145 my($self, $builder) = @_;
20 37     37   2183 $self->{builder} = sub { Plack::Middleware::BufferedStreaming->wrap($builder->()) };
  37         2488  
21             }
22              
23             sub run {
24 37     37 0 333 my($self, $server) = @_;
25              
26             my $app = sub {
27 703     703   1882 my $env = shift;
28              
29 703         26899 pipe my $read, my $write;
30              
31 703         1691391 my $pid = fork;
32 703 100       40196 if ($pid) {
33             # parent
34 666         47240 close $write;
35 666         6384905 my $res = Storable::thaw(join '', <$read>);
36 666         65541 close $read;
37 666         613197997 waitpid($pid, 0);
38              
39 666         37522 return $res;
40             } else {
41             # child
42 37         5296 close $read;
43              
44 37         2418 my $res;
45             try {
46 37         19545 $env->{'psgi.streaming'} = 0;
47 37         1946 $res = $self->{builder}->()->($env);
48 36         1549 my @body;
49 36         2271 Plack::Util::foreach($res->[2], sub { push @body, $_[0] });
  39         645  
50 36         3427 $res->[2] = \@body;
51             } catch {
52 1         123 $env->{'psgi.errors'}->print($_);
53 1         38 $res = [ 500, [ "Content-Type", "text/plain" ], [ "Internal Server Error" ] ];
54 37         12831 };
55              
56 37         108535 print {$write} Storable::freeze($res);
  37         1424  
57 37         10392 close $write;
58 37         23579 exit;
59             }
60 37         629 };
61              
62 37         222 $server->run($app);
63             }
64              
65             1;
66              
67             __END__