view release on metacpan or  search on metacpan

lib/CGI/Fast.pm  view on Meta::CPAN

package CGI::Fast;
use strict;
use warnings;
use if $] >= 5.019, 'deprecate';

$CGI::Fast::VERSION='2.17';

use CGI;
use CGI::Carp;
use FCGI;

our @ISA = ('CGI');

# workaround for known bug in libfcgi
while (() = each %ENV) { }

# override the initialization behavior so that
# state is NOT maintained between invocations
sub save_request {
    # no-op
}

# If ENV{FCGI_SOCKET_PATH} is specified, we maintain a FCGI Request handle
# in this package variable.
our ($Ext_Request, $socket, $socket_perm, $queue);

sub import {
    my ($package,@import) = @_;
    # check imports for this class then pass on
    # imports to SUPER class
    for (my $i = 0; $i < scalar( @import ); $i++) {
        if ( $import[$i] eq 'socket_path' ) {
            $socket = $import[$i+1];
        } elsif ( $import[$i] eq 'socket_perm' ) {
            $socket_perm = $import[$i+1];
        } elsif ( $import[$i] eq 'listen_queue' ) {
            $queue = $import[$i+1];
        }
    }
    $package->SUPER::import(@import);
}

sub _create_fcgi_request {
    my ( $in_fh,$out_fh,$err_fh ) = @_;
    # If we have a socket set, explicitly open it
    if ($ENV{FCGI_SOCKET_PATH} or $socket) {
        my $path    = $ENV{FCGI_SOCKET_PATH}  || $socket;
        my $perm    = $ENV{FCGI_SOCKET_PERM}  || $socket_perm;
        my $backlog = $ENV{FCGI_LISTEN_QUEUE} || $queue || 100;
        my $socket  = FCGI::OpenSocket( $path, $backlog );
        if ($path !~ /^:/ && defined $perm) {
            chmod $perm, $path or croak( "Couldn't chmod($path): $!" );
        }
        return FCGI::Request(
            ( $in_fh  || \*STDIN ),
            ( $out_fh || \*STDOUT ),
            ( $err_fh || \*STDERR ),
            \%ENV,
            $socket,
            1
        );
    }
    else {
        return FCGI::Request(
            ( $in_fh  || \*STDIN ),
            ( $out_fh || \*STDOUT ),
            ( $err_fh || \*STDERR ),
        );
    }
}

{
    my ( $in_fh,$out_fh,$err_fh );

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

        if ( ref( $handles ) eq 'HASH' ) {
            $in_fh  = delete( $handles->{fcgi_input_file_handle} );
            $out_fh = delete( $handles->{fcgi_output_file_handle} );
            $err_fh = delete( $handles->{fcgi_error_file_handle} );
        }
    }

    sub new {

		#
		# the interface to the ->new method is unfortunately somewhat
		# overloaded as it can be passed:
		#
		#         nothing
		#         an upload hook, "something", 0
		#         an initializer, an upload hook, "something", 0
		#
		# these then get passed through to the SUPER class (CGI.pm) that
		# also has a constructor that can take various order of args
		#
        my ($self, @args) = @_;

        if (
			! $args[0]
			|| (
				ref( $args[0] )
				&& UNIVERSAL::isa( $args[0],'CODE' )
				&& ! $args[3]
			)
		) {
            $Ext_Request ||= _create_fcgi_request( $in_fh,$out_fh,$err_fh );
			my $accept = $Ext_Request->Accept;
            return undef unless ( defined $accept && $accept >= 0 );
        }
        CGI->_reset_globals;