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   7423756 use strict;
  38         76  
  38         1444  
3 38     38   190 use parent qw(Plack::Loader);
  38         38  
  38         380  
4 38     38   2052 use Storable;
  38         38  
  38         2166  
5 38     38   114 use Try::Tiny;
  38         76  
  38         1406  
6 38     38   14326 use Plack::Middleware::BufferedStreaming;
  38         114  
  38         11590  
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 2775 my($self, $builder) = @_;
20 37     37   2294 $self->{builder} = sub { Plack::Middleware::BufferedStreaming->wrap($builder->()) };
  37         2456  
21             }
22              
23             sub run {
24 37     37 0 222 my($self, $server) = @_;
25              
26             my $app = sub {
27 703     703   1128 my $env = shift;
28              
29 703         23755 pipe my $read, my $write;
30              
31 703         1516105 my $pid = fork;
32 703 100       37392 if ($pid) {
33             # parent
34 666         40467 close $write;
35 666         5814791 my $res = Storable::thaw(join '', <$read>);
36 666         71336 close $read;
37 666         575196177 waitpid($pid, 0);
38              
39 666         36665 return $res;
40             } else {
41             # child
42 37         5525 close $read;
43              
44 37         2235 my $res;
45             try {
46 37         15895 $env->{'psgi.streaming'} = 0;
47 37         2305 $res = $self->{builder}->()->($env);
48 36         23925 my @body;
49 36         1511 Plack::Util::foreach($res->[2], sub { push @body, $_[0] });
  39         703  
50 36         3293 $res->[2] = \@body;
51             } catch {
52 1         151 $env->{'psgi.errors'}->print($_);
53 1         32 $res = [ 500, [ "Content-Type", "text/plain" ], [ "Internal Server Error" ] ];
54 37         12038 };
55              
56 37         1547 print {$write} Storable::freeze($res);
  37         20965  
57 37         10357 close $write;
58 37         21418 exit;
59             }
60 37         666 };
61              
62 37         148 $server->run($app);
63             }
64              
65             1;
66              
67             __END__