Plack-App-CGIBin-Streaming

 view release on metacpan or  search on metacpan

lib/Plack/App/CGIBin/Streaming.pm  view on Meta::CPAN

sub mkapp {
    my ($self, $sub) = @_;

    return sub {
        my $env = shift;
        return sub {
            my $responder = shift;

            local $env->{SCRIPT_NAME} = $env->{'plack.file.SCRIPT_NAME'};
            local $env->{PATH_INFO}   = $env->{'plack.file.PATH_INFO'};

            my @env_keys = grep !/^(?:plack|psgi.*)\./, keys %$env;
            local @ENV{@env_keys} = @{$env}{@env_keys};

            select STDOUT;
            $|=0;
            binmode STDOUT, 'via(Plack::App::CGIBin::Streaming::IO)';

            my $class = ($self->request_class //
                         'Plack::App::CGIBin::Streaming::Request');
            local $R = $class->new
                (
                 env => $env,
                 responder => $responder,
                 @{$self->request_params//[]},
                );

            local *STDIN = $env->{'psgi.input'};
            binmode STDIN, 'via(Plack::App::CGIBin::Streaming::IO)';

            # CGI::Compile localizes $0 and %SIG and calls
            # CGI::initialize_globals.
            my $err = eval {
                local ($/, $\) = ($/, $\);
                $sub->() // '';
            };
            my $exc = $@;
            $R->suppress_flush=1;   # turn off normal flush behavior
            $R->binmode_ok=1;       # allow binmode to remove the layer
            {
                no warnings 'uninitialized';
                binmode STDOUT;
                binmode STDIN;
            }
            unless (defined $err) {
                warn "$env->{REQUEST_URI}: It's too late to set a HTTP status"
                    if $R->status_written;
                $R->status(500);
            }
            $R->finalize;
            unless (defined $err) { # $sub died
                warn "$env->{REQUEST_URI}: $exc";
            }
        };
    };
}

sub serve_path {
    my($self, $env, $file) = @_;

    die "need a server that supports streaming" unless $env->{'psgi.streaming'};

    my $app = $self->{_compiled}->{$file} ||= do {
        local $0 = $file;            # keep FindBin happy

        $self->mkapp(CGI::Compile->compile($file));
    };

    $app->($env);
}

1;

__END__

=encoding utf-8

=head1 NAME

Plack::App::CGIBin::Streaming - allow old style CGI applications to use
the plack streaming protocol

=head1 SYNOPSIS

in your F<app.psgi>:

 use Plack::App::CGIBin::Streaming;

 Plack::App::CGIBin::Streaming->new(root=>...)->to_app;

=head1 DESCRIPTION

With L<Plack> already comes L<Plack::App::CGIBin>.
C<Plack::App::CGIBin::Streaming> serves a very similar purpose.

So, why do I need another module? The reason is that L<Plack::App::CGIBin>
first collects all the output from your CGI scripts before it prints the
first byte to the client. This renders the following simple clock script
useless:

 use strict;
 use warnings;

 $|=0;

 my $boundary='The Final Frontier';
 print <<"EOF";
 Status: 200
 Content-Type: multipart/x-mixed-replace;boundary="$boundary";

 EOF

 $boundary="--$boundary\n";

 my $mpheader=<<'HEADER';
 Content-type: text/html; charset=UTF-8;

 HEADER

 for(1..100) {
     print ($boundary, $mpheader,
            '<html><body><h1>'.localtime()."</h1></body></html>\n");
     $|=1; $|=0;
     sleep 1;
 }

 print ($boundary);

Although multipart HTTP messages are quite exotic, there are situations
where you rather want to prevent this buffering. If your document is very
large for example, each instance of your plack server allocates the RAM
to buffer it. Also, you might perhaps send out the C<< <head> >> section
of your HTTP document as fast as possible to enable the browser load JS and
CSS while the plack server is still busy with producing the actual document.

C<Plack::App::CGIBin::Streaming> compiles the CGI scripts using
L<CGI::Compile> and provides a runtime environment similar to
C<Plack::App::CGIBin>. Compiled scripts are cached. For production
environments, it is possible to precompile and cache scripts at server
start time, see the C<preload> option below.



( run in 0.711 second using v1.01-cache-2.11-cpan-140bd7fdf52 )