view release on metacpan or  search on metacpan

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

        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},
            on_request => sub { $self->request_loop(@_); }
        );

    } else {
        $self->log_info( sprintf 'Listening on INET socket: %s:%s', $self->{ip}, $self->{port} );
        $fcgi = AnyEvent::FCGI->new(
            port       => $self->{port},
            host       => $self->{ip},
            on_request => sub { $self->request_loop(@_) }
        );
    }

    $self->log_info( 'Entering main listen loop using ' . $AnyEvent::MODEL );
    AnyEvent::CondVar->recv;

}

1;

__END__

=pod

=head1 NAME

App::FastishCGI - provide CGI support to webservers which don't have it

=head1 VERSION

version 0.002

=head1 INSTALLATION 

=over

=item * 
Normally, via CPAN, or

=item *
Debian sid packages available at L<https://github.com/ioanrogers/App-FastishCGI/downloads>