| 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__ |