All pastes #268689 Raw Edit

Anonymous

public text v1 · immutable
·published 2006-12-05 22:45 UTC
rendered paste body
package Catalyst::Engine::SCGI;

use strict;
use base 'Catalyst::Engine::CGI';
eval "use SCGI";
die "Please install SCGI\n" if $@;
use IO::Socket;

sub run {
    my ( $self, $class, $listen, $options ) = @_;

    my $sock = 0;
    my $old_umask = umask;
    unless ( $options->{leave_umask} ) {
        umask(0);
    }
	my $socket = IO::Socket::INET->new(Listen => 5, ReuseAddr => 1, LocalPort => 8050)
	 	or die "cannot bind to port 8080: $!";
	$sock = SCGI->new($socket, blocking => 1)
	or die "Failed to open SCGI socket; $!";
    unless ( $options->{leave_umask} ) {
        umask($old_umask);
    }


    $options ||= {};

    my $error = \*STDERR; # send STDERR to the web server
       $error = \*STDOUT;  # send STDERR to stdout (a logfile)
    
	use Data::Dumper; # delete and tab if you don't need it
     while (my $request = $sock->accept) {
		$request->read_env;
		#$self->{_request}=$request;
		*STDOUT->syswrite(Dumper($request->env));
        $class->handle_request( env => $request->env );
		# *STDOUT->syswrite($request->connection("Content-Type: text/plain\n\nHello!\n"));
    }
}

=head2 $self->write($c, $buffer)

=cut

sub write {
    my ( $self, $c, $buffer ) = @_;

    unless ( $self->{_prepared_write} ) {
        $self->prepare_write($c);
        $self->{_prepared_write} = 1;
    }
	#$c->request->{_body}=$buffer;
	$self->{_request}->connection->print($buffer);
	$c->{request}->{_request}->close();
    *STDOUT->syswrite($buffer);
	#$c->{request}->{_request}->close();
}

=head2 $self->daemon_fork()

Performs the first part of daemon initialisation.  Specifically,
forking.  STDERR, etc are still connected to a terminal.

=cut

sub daemon_fork {
    require POSIX;
    fork && exit;
}

=head2 $self->daemon_detach( )

Performs the second part of daemon initialisation.  Specifically,
disassociates from the terminal.

However, this does B<not> change the current working directory to "/",
as normal daemons do.  It also does not close all open file
descriptors (except STDIN, STDOUT and STDERR, which are re-opened from
F</dev/null>).

=cut

sub daemon_detach {
    my $self = shift;
    print "SCGI daemon started (pid $$)\n";
    open STDIN,  "+</dev/null" or die $!;
    open STDOUT, ">&STDIN"     or die $!;
    open STDERR, ">&STDIN"     or die $!;
    POSIX::setsid();
}

1;