view release on metacpan or  search on metacpan

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

package Plack::App::CGIBin::Streaming;

use 5.014;
use strict;
use warnings;
our $VERSION = '0.06';

BEGIN {
    # this works around a bug in perl

    # In Perl (at least up to 5.18.0) the first assignment to $SIG{CHLD}
    # or $SIG{CLD} determines which name is later passed to the signal handler
    # on systems like Linux that support both names.
    # This hack tries to be the first such assignment in the perl program
    # and thus pin down that name.
    # Net::Server based servers like starman rely on "CHLD" to be passed to
    # the signal handler.
    local $SIG{CHLD}=$SIG{CHLD};
}

use parent qw/Plack::App::File/;
use CGI;
use CGI::Compile;
use File::Spec;
use Plack::App::CGIBin::Streaming::Request;
use Plack::App::CGIBin::Streaming::IO;

use Plack::Util::Accessor qw/request_class
                             request_params
                             preload/;

sub allow_path_info { 1 }

sub prepare_app {
    my $self=shift;

    # warn "\n\nprepare_app [@{$self->preload}]\n\n";

    $self->SUPER::prepare_app;
    return unless $self->preload;

    for my $pattern (@{$self->preload}) {
        my $pat=($pattern=~m!^/!
                 ? $pattern
                 : $self->root.'/'.$pattern);
        # warn "  pat=$pat\n";
        for my $fn (glob $pat) {
            # warn "preloading $fn\n";
            $self->{_compiled}->{$fn} = do {
                local $0 = $fn;            # keep FindBin happy

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

our $R;
sub request { return $R }

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;

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

L<Plack::App::CGIBin::Streaming::IO> PerlIO layer.
On output, the layer captures the data and sends it to the
request object. Flushing via C<$|> is also supported.
On input, the layer simply converts calls like C<readline STDIN>
into a method call on the underlying object.

You can use PerlIO layers to turn the handles into UTF8 mode.
However, refrain from using a simple C<binmode> to reverse the
effects of a prior C<binmode STDOUT, ':utf8'>. This won't pop
the L<Plack::App::CGIBin::Streaming::IO> layer but neither
will it turn off UTF8 mode. This is considered a bug that I don't
know how to fix. (See also below)

Reading from C<STDIN> using UTF8 mode is also supported.

=back

=head2 Pitfalls and workarounds

=head3 SIGCHLD vs. SIGCLD

During the implementation I found a wierd bug. At least on Linux, perl
supports C<CHLD> and C<CLD> as name of the signal that is sent when a child
process exits. Also, when Perl calls a signal handler, it passes the signal
name as the first parameter. Now the question arises, which name is passed
when a child exits. As it happens the first assignment to C<%SIG{CHLD}>
or C<$SIG{CLD}> determines that name for the rest of the lifetime of the
process. Now, several plack server implementations, e.g. L<Starman>,
rely on that name to be C<CHLD>.

As a workaround, C<Plack::App::CGIBin::Streaming> contains this code:

 BEGIN {
     local $SIG{CHLD}=$SIG{CHLD};
 }

If your server dies when it receives a SIGCHLD, perhaps the module is loaded
too late.

=head3 binmode

Sometimes one needs to switch STDOUT into UTF8 mode and back. Especially the
I<back> is problematic because the way it is done is often simply
C<binmode STDOUT>. Currently, this won't revert the effect of a previous
C<binmode STDOUT, ':utf8'>.

Instead use:

 binmode STDOUT, ':bytes';

=head1 EXAMPLE

This distribution contains a complete example in the F<eg/> directory.
After building the module by

 perl Build.PL
 ./Build

you can try it out:

 (cd eg && starman -l :5091 --workers=2 --preload-app app.psgi) &

Then you should be able to access

=over 4

=item * L<http://localhost:5091/clock.cgi?30>

=item * L<http://localhost:5091/flush.cgi>

=back

The clock example is basically the script displayed above. It works in Firefox.
Other browsers don't support multipart HTTP messages.

The flush example demonstrates filtering. It has been tested wich Chromium
35 on Linux. The script first prints a part of the page that contains the
HTML comment C<< <!-- FlushHead --> >>. The filter recognizes this token
and pushes the page out. You should see a red background and the string
C<loading -- please wait>. After 2 seconds the page should turn green and
the string should change to C<loaded>.

All of this very much depends on browser behavior. The intent is not to
provide an example that works for all of them. Instead, the capabilities
of this module are shown. You can also test these links with C<curl>
instead.

The example PSGI file also configures an F<access_log> and an F<error_log>.

=head1 AUTHOR

Torsten Förtsch E<lt>torsten.foertsch@gmx.netE<gt>

=head1 COPYRIGHT

Copyright 2014 Binary.com

=head1 LICENSE

This program is free software; you can redistribute it and/or modify it
under the terms of the the Artistic License (2.0). A copy of the full
license is provided by the F<LICENSE> file in this distribution and can
be obtained at

L<http://www.perlfoundation.org/artistic_license_2_0>

=head1 SEE ALSO

=over 4

=item * L<Plack::App::CGIBin>

=item * L<CGI::Compile>

=item * L<Plack::App::CGIBin::Streaming::Request>

=item * L<Plack::App::CGIBin::Streaming::IO>

=back

=cut