view release on metacpan or  search on metacpan

lib/App/FastishCGI.pm  view on Meta::CPAN

    my ( $wtr, $rdr, $err );

    my $pid;
    eval { $pid = IPC::Open3::open3( $wtr, $rdr, $err, $script_filename ); };

    if ($@) {
        $self->html_error( $req, "$script_filename: Failed to open script: $@" );
        return;
    }

    if ( !$pid ) {
        $self->html_error( $req, "$script_filename: Failed to open script: $!" );
        return;
    }

    if ( ( $req->param('REQUEST_METHOD') eq 'POST' ) && ( $req->param('CONTENT_LENGTH') + 0 > 0 ) )
    {
        my $req_len = 0 + $req->param('CONTENT_LENGTH');
        $self->log_debug("[$rid] Request length $req_len");
        my $post_data = $req->read_stdin($req_len);
        $self->log_debug("[$rid] POST data $post_data");
        $wtr->print($post_data);
    }

    $self->{requests}->{$rid}->{handle} = AnyEvent::Handle->new(
        fh      => $rdr,
        on_read => sub {
            $self->{requests}->{$rid}->{buffer} .= $_[0]->rbuf;
            $_[0]->rbuf = '';
        },
        on_eof => sub {
            undef $self->{requests}->{$rid}->{handle};
        },
    );

    $self->{requests}->{$rid}->{child} = AnyEvent->child(
        pid => $pid,
        cb  => sub {
            my ( $pid, $return_val ) = @_;
            my $status = $return_val >> 8;

            # XXX the cgi spec, as far as I have found, is like shell scripting in
            # that scripts should return 0 on success. However some of the scripts I
            # need to use return 1 instead.
            if ( $status != 0 && $status != 1 ) {
                $self->html_error(
                    $req,
                    "Script $script_filename exited abnormally, with status: $status",
                    $self->{requests}->{$rid}->{buffer}
                );
            } else {
                $self->log_debug("[$rid] Script $script_filename completed");
                $req->print_stdout( $self->{requests}->{$rid}->{buffer} );
                $req->finish;
            }
            $self->clear_request($rid);
        },
    );

    $self->{requests}->{$rid}->{timer} = AnyEvent->timer(
        after => $self->{timeout},
        cb    => sub {
            $self->html_error( $req, "Script '$script_filename' exceeded timeout value" );
            $self->clear_request($rid);
        }
    );

    $self->log_debug("[$rid] setup");
    $self->show_active_requests if $self->{debug};

    return;

}

sub new {
    my $this  = shift;
    my $class = ref($this) || $this;
    my %opt   = ( ref $_[0] eq 'HASH' ) ? %{ $_[0] } : @_;
    my $self  = bless \%opt, $class;
    $self->log_debug( Dumper($self) ) if $self->{debug};
    $self->_init;

    return $self;
}

sub _init {
    my $self = shift;
    $self->set_signal_handlers;

    openlog( 'fastishcgi', "ndelay,pid", 'user' );

    # stylesheet is a url or path for web server. If none is supplied add default
    if ( $self->{css} ) {
        $self->{css} = sprintf '<link href="%s" rel="stylesheet" type="text/css">', $self->{css};
    } else {
        $self->{css} = <<CSS;
<style type="text/css">
pre { background-color: white; padding: 1em; border: 2px solid orange; color: black; }
body {color: black; background-color: grey; }
.err_msg {color: black; background-color: orange; }
</style>
CSS

    }

    $self->{requests_total} = 0;
    $self->{requests}       = {};

}

sub main_loop {

    my $self = shift;
    my $fcgi;

    # TODO IO::Socket::INET6
    if ( defined $self->{socket} ) {
        $self->log_info( sprintf 'Listening on UNIX socket: %s', $self->{socket} );
        $fcgi = AnyEvent::FCGI->new(
            socket     => $self->{socket},