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   14493846 use strict;
  38         76  
  38         1368  
3 38     38   152 use parent qw(Plack::Loader);
  38         76  
  38         266  
4 38     38   2090 use Storable;
  38         76  
  38         2090  
5 38     38   114 use Try::Tiny;
  38         76  
  38         1482  
6 38     38   15846 use Plack::Middleware::BufferedStreaming;
  38         76  
  38         12540  
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 2331 my($self, $builder) = @_;
20 37     37   3922 $self->{builder} = sub { Plack::Middleware::BufferedStreaming->wrap($builder->()) };
  37         2748  
21             }
22              
23             sub run {
24 37     37 0 259 my($self, $server) = @_;
25              
26             my $app = sub {
27 703     703   1561 my $env = shift;
28              
29 703         32233 pipe my $read, my $write;
30              
31 703         2938413 my $pid = fork;
32 703 100       288735 if ($pid) {
33             # parent
34 666         53797 close $write;
35 666         9644226 my $res = Storable::thaw(join '', <$read>);
36 666         86820 close $read;
37 666         1032074871 waitpid($pid, 0);
38              
39 666         53010 return $res;
40             } else {
41             # child
42 37         6494 close $read;
43              
44 37         2168 my $res;
45             try {
46 37         25186 $env->{'psgi.streaming'} = 0;
47 37         2293 $res = $self->{builder}->()->($env);
48 36         2622 my @body;
49 36         83012 Plack::Util::foreach($res->[2], sub { push @body, $_[0] });
  39         61805  
50 36         5359 $res->[2] = \@body;
51             } catch {
52 1         221 $env->{'psgi.errors'}->print($_);
53 1         41 $res = [ 500, [ "Content-Type", "text/plain" ], [ "Internal Server Error" ] ];
54 37         13567 };
55              
56 37         2743 print {$write} Storable::freeze($res);
  37         29919  
57 37         32920 close $write;
58 37         29174 exit;
59             }
60 37         481 };
61              
62 37         185 $server->run($app);
63             }
64              
65             1;
66              
67             __END__