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   20634 use strict;
  38         76  
  38         1368  
3 38     38   190 use parent qw(Plack::Loader);
  38         76  
  38         266  
4 38     38   2432 use Storable;
  38         76  
  38         2432  
5 38     38   190 use Try::Tiny;
  38         76  
  38         1862  
6 38     38   17784 use Plack::Middleware::BufferedStreaming;
  38         114  
  38         15922  
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 4070 my($self, $builder) = @_;
20 37     37   5550 $self->{builder} = sub { Plack::Middleware::BufferedStreaming->wrap($builder->()) };
  37         1819  
21             }
22              
23             sub run {
24 37     37 0 296 my($self, $server) = @_;
25              
26             my $app = sub {
27 703     703   1917 my $env = shift;
28              
29 703         30253 pipe my $read, my $write;
30              
31 703         961206 my $pid = fork;
32 703 100       38511 if ($pid) {
33             # parent
34 666         31861 close $write;
35 666         2302187 my $res = Storable::thaw(join '', <$read>);
36 666         81094 close $read;
37 666         689640676 waitpid($pid, 0);
38              
39 666         66338 return $res;
40             } else {
41             # child
42 37         5307 close $read;
43              
44 37         1496 my $res;
45             try {
46 37         17407 $env->{'psgi.streaming'} = 0;
47 37         1940 $res = $self->{builder}->()->($env);
48 36         2825 my @body;
49 36         2624 Plack::Util::foreach($res->[2], sub { push @body, $_[0] });
  39         522  
50 36         5247 $res->[2] = \@body;
51             } catch {
52 1         180 $env->{'psgi.errors'}->print($_);
53 1         51 $res = [ 500, [ "Content-Type", "text/plain" ], [ "Internal Server Error" ] ];
54 37         9582 };
55              
56 37         1647 print {$write} Storable::freeze($res);
  37         1317  
57 37         10349 close $write;
58 37         21294 exit;
59             }
60 37         1184 };
61              
62 37         296 $server->run($app);
63             }
64              
65             1;
66              
67             __END__