# Declare our package
package POE::Component::Server::SimpleHTTP::PreFork;

# Standard stuff to catch errors
use strict qw(subs vars refs);				# Make sure we can't mess up
use warnings FATAL => 'all';				# Enable warnings to catch errors

# Initialize our version
# $Revision: 1181 $
our $VERSION = '0.01';

# Import what we need from the POE namespace
use POE;
use base qw( POE::Component::Server::SimpleHTTP );

# Other miscellaneous modules we need
use Carp qw( croak );

# HTTP-related modules
use HTTP::Date qw( time2str );

# IPC modules
use IPC::Shareable qw( :lock );

# Set some constants
BEGIN {
	# Interval at which to check spares
	if ( ! defined &CHECKSPARES_INTERVAL ) {
		eval "sub CHECKSPARES_INTERVAL () { 1 }";
	}

	# Interval at which to retry preforking
	if ( ! defined &PREFORK_INTERVAL ) {
		eval "sub PREFORK_INTERVAL () { 5 }";
	}

	# If true, show the scoreboard every second
	if ( ! defined &DEBUGSB ) {
		eval "sub DEBUGSB () { 0 }";
	}
}

# Set things in motion!
sub new {
	# Get the OOP's type
	my $type = shift;

	# Sanity checking
	if ( @_ & 1 ) {
		croak( 'POE::Component::Server::SimpleHTTP::PreFork->new needs even number of options' );
	}

	# The options hash
	my %opt = @_;

	# Our own options
	my ( $ALIAS, $ADDRESS, $PORT, $HOSTNAME, $HEADERS, $HANDLERS, $SSLKEYCERT );
	# options for pre-forking
	my ( $FORKHANDLERS, $STARTSERVERS, $MINSPARESERVERS, $MAXSPARESERVERS, $MAXCLIENTS, $MAXREQUESTPERCHILD );

	# You could say I should do this: $Stuff = delete $opt{'Stuff'}
	# But, that kind of behavior is not defined, so I would not trust it...

	# Get the SSL array
	if ( exists $opt{'SSLKEYCERT'} and defined $opt{'SSLKEYCERT'} ) {
		# Test if it is an array
		if ( ref( $opt{'SSLKEYCERT'} ) eq 'ARRAY' and scalar( @{ $opt{'SSLKEYCERT'} } ) == 2 ) {
			$SSLKEYCERT = $opt{'SSLKEYCERT'};
			delete $opt{'SSLKEYCERT'};

			# Okay, pull in what is necessary
			eval {
				use POE::Component::SSLify qw( SSLify_Options SSLify_GetSocket Server_SSLify SSLify_GetCipher );
				SSLify_Options( @$SSLKEYCERT );
			};
			if ( $@ ) {
				if ( POE::Component::Server::SimpleHTTP::DEBUG ) {
					warn "Unable to load PoCo::SSLify -> $@";
				}

				# Force ourself to not use SSL
				$SSLKEYCERT = undef;
			}
		} else {
			if ( POE::Component::Server::SimpleHTTP::DEBUG ) {
				warn 'The SSLKEYCERT option must be an array with exactly 2 elements in it!';
			}
		}
	} else {
		$SSLKEYCERT = undef;
	}

	# Get the session alias
	if ( exists $opt{'ALIAS'} and defined $opt{'ALIAS'} and length( $opt{'ALIAS'} ) ) {
		$ALIAS = $opt{'ALIAS'};
		delete $opt{'ALIAS'};
	} else {
		# Debugging info...
		if ( POE::Component::Server::SimpleHTTP::DEBUG ) {
			warn 'Using default ALIAS = SimpleHTTP';
		}

		# Set the default
		$ALIAS = 'SimpleHTTP';

		# Get rid of any lingering ALIAS
		if ( exists $opt{'ALIAS'} ) {
			delete $opt{'ALIAS'};
		}
	}

	# Get the PORT
	if ( exists $opt{'PORT'} and defined $opt{'PORT'} and length( $opt{'PORT'} ) ) {
		$PORT = $opt{'PORT'};
		delete $opt{'PORT'};
	} else {
		croak( 'PORT is required to create a new POE::Component::Server::SimpleHTTP instance!' );
	}

	# Get the ADDRESS
	if ( exists $opt{'ADDRESS'} and defined $opt{'ADDRESS'} and length( $opt{'ADDRESS'} ) ) {
		$ADDRESS = $opt{'ADDRESS'};
		delete $opt{'ADDRESS'};
	} else {
		croak( 'ADDRESS is required to create a new POE::Component::Server::SimpleHTTP instance!' );
	}

	# Get the HOSTNAME
	if ( exists $opt{'HOSTNAME'} and defined $opt{'HOSTNAME'} and length( $opt{'HOSTNAME'} ) ) {
		$HOSTNAME = $opt{'HOSTNAME'};
		delete $opt{'HOSTNAME'};
	} else {
		if ( POE::Component::Server::SimpleHTTP::DEBUG ) {
			warn 'Using Sys::Hostname for HOSTNAME';
		}

		# Figure out the hostname
		require Sys::Hostname;
		$HOSTNAME = Sys::Hostname::hostname();

		# Get rid of any lingering HOSTNAME
		if ( exists $opt{'HOSTNAME'} ) {
			delete $opt{'HOSTNAME'};
		}
	}

	# Get the HEADERS
	if ( exists $opt{'HEADERS'} and defined $opt{'HEADERS'} ) {
		# Make sure it is ref to hash
		if ( ref $opt{'HEADERS'} and ref( $opt{'HEADERS'} ) eq 'HASH' ) {
			$HEADERS = $opt{'HEADERS'};
			delete $opt{'HEADERS'};
		} else {
			croak( 'HEADERS must be a reference to a HASH!' );
		}
	} else {
		# Set to none
		$HEADERS = {};

		# Get rid of any lingering HEADERS
		if ( exists $opt{'HEADERS'} ) {
			delete $opt{'HEADERS'};
		}
	}

	# Get the HANDLERS
	if ( exists $opt{'HANDLERS'} and defined $opt{'HANDLERS'} ) {
		# Make sure it is ref to array
		if ( ref $opt{'HANDLERS'} and ref( $opt{'HANDLERS'} ) eq 'ARRAY' ) {
			$HANDLERS = $opt{'HANDLERS'};
			delete $opt{'HANDLERS'};
		} else {
			croak( 'HANDLERS must be a reference to an ARRAY!' );
		}
	} else {
		croak( 'HANDLERS is required to create a new POE::Component::Server::SimpleHTTP instance!' );
	}

	# Get the FORKHANDLERS
	if ( exists $opt{'FORKHANDLERS'} and defined $opt{'FORKHANDLERS'} ) {
		# Make sure it is ref to a hash
		if ( ref $opt{'FORKHANDLERS'} and ref( $opt{'FORKHANDLERS'} ) eq 'HASH' ) {
			$FORKHANDLERS = $opt{'FORKHANDLERS'};
			delete $opt{'FORKHANDLERS'};
		} else {
			croak( 'FORKHANDLERS must be a reference to a HASH!' );
		}
	} else {
		$FORKHANDLERS = {};

		# Get rid of any lingering FORKHANDLERS
		if ( exists $opt{'FORKHANDLERS'} ) {
			delete $opt{'FORKHANDLERS'};
		}
	}

	# Get the MINSPARESERVERS
	if ( exists $opt{'MINSPARESERVERS'} and defined $opt{'MINSPARESERVERS'} ) {
		$MINSPARESERVERS = int $opt{'MINSPARESERVERS'};
		delete $opt{'MINSPARESERVERS'};

		if ( $MINSPARESERVERS <= 0 ) {
			croak( 'MINSPARESERVERS must be greater than 0!' );
		}
	} else {
		$MINSPARESERVERS = 5;

		# Get rid of any lingering MINSPARESERVERS
		if ( exists $opt{'MINSPARESERVERS'} ) {
			delete $opt{'MINSPARESERVERS'};
		}
	}

	# Get the MAXSPARESERVERS
	if (exists $opt{'MAXSPARESERVERS'} and defined $opt{'MAXSPARESERVERS'} ) {
		$MAXSPARESERVERS = int $opt{'MAXSPARESERVERS'};
		delete $opt{'MAXSPARESERVERS'};
	} else {
		$MAXSPARESERVERS = 10;

		# Get rid of any lingering MAXSPARESERVERS
		if ( exists $opt{'MAXSPARESERVERS'} ) {
			delete $opt{'MAXSPARESERVERS'};
		}
	}
	# Adjust and make sure MAXSPARESERVERS makes sense
	if ( $MAXSPARESERVERS <= $MINSPARESERVERS ) {
		if ( POE::Component::Server::SimpleHTTP::DEBUG ) {
			warn 'MAXSPARESERVERS is less than or equal to MINSPARESERVERS. Resetting.';
		}

		$MAXSPARESERVERS = $MINSPARESERVERS + 1;
	}

	# Get the MAXCLIENTS
	if (exists $opt{'MAXCLIENTS'} and defined $opt{'MAXCLIENTS'} ) {
		$MAXCLIENTS = int $opt{'MAXCLIENTS'};
		delete $opt{'MAXCLIENTS'};
	} else {
		$MAXCLIENTS = 256;

		# Get rid of any lingering MAXCLIENTS
		if ( exists $opt{'MAXCLIENTS'} ) {
			delete $opt{'MAXCLIENTS'};
		}
	}

	# Get the MAXREQUESTPERCHILD
	if (exists $opt{'MAXREQUESTPERCHILD'} and defined $opt{'MAXREQUESTPERCHILD'} ) {
		$MAXREQUESTPERCHILD = int $opt{'MAXREQUESTPERCHILD'};
		delete $opt{'MAXREQUESTPERCHILD'};

		if ( $MAXREQUESTPERCHILD <= 0 ) {
			croak( 'MAXREQUESTPERCHILD must be greater than 0!' );
		}
	}
        
	# Get the STARTSERVERS
	if (exists $opt{'STARTSERVERS'} and defined $opt{'STARTSERVERS'} ) {
		$STARTSERVERS = int $opt{'STARTSERVERS'};
		delete $opt{'STARTSERVERS'};

		if ( $STARTSERVERS <= 0 ) {
			croak( 'STARTSERVERS must be greater than or equal to 0!' );
		}
	} else {
		$STARTSERVERS = 10;

		# Get rid of any lingering STARTSERVERS
		if ( exists $opt{'STARTSERVERS'} ) {
			delete $opt{'STARTSERVERS'};
		}
	}
	# Adjust and make sure STARTSERVERS makes sense
	if ( $STARTSERVERS < $MINSPARESERVERS ) {
		if ( POE::Component::Server::SimpleHTTP::DEBUG ) {
			warn 'STARTSERVERS is less than MINSPARESERVERS. Resetting.';
		}

		$STARTSERVERS = $MINSPARESERVERS;
	}

	# Anything left over is unrecognized
	if ( POE::Component::Server::SimpleHTTP::DEBUG ) {
		if ( keys %opt > 0 ) {
			croak( 'Unrecognized options were present in POE::Component::Server::SimpleHTTP::PreFork->new -> ' . join( ', ', keys %opt ) );
		}
	}

	# Create a new session for ourself
	POE::Session->create(
		# Our subroutines
		'inline_states'	=>	{
			# Maintenance events
			'_start'		=>	\&StartServer,
			'_stop'			=>	\&POE::Component::Server::SimpleHTTP::FindRequestLeaks,
			'_child'		=>	sub {},

			# Pre-forking events
			'ISCHILD'		=>	\&IsChild,
			'GETFORKHANDLERS'	=>	\&GetForkHandlers,
			'SETFORKHANDLERS'	=>	\&SetForkHandlers,

			# Internal pre-forking events
			'SigCHLD'		=>	\&SigCHLD,
			'SigTERM'		=>	\&SigTERM,
			'PreFork'		=>	\&PreFork,
			'KillChildren'		=>	\&KillChildren,
			'CheckSpares'		=>	\&CheckSpares,
			'UpdateScoreboard'	=>	\&UpdateScoreboard,
			'AddScoreboard'		=>	\&AddScoreboard,
			'ShowScoreboard'	=>	\&ShowScoreboard,

			# HANDLER stuff
			'GETHANDLERS'		=>	\&POE::Component::Server::SimpleHTTP::GetHandlers,
			'SETHANDLERS'		=>	\&SetHandlers,

			# SocketFactory events
			'SHUTDOWN'		=>	\&StopServer,
			'STOPLISTEN'		=>	\&StopListen,
			'STARTLISTEN'		=>	\&StartListen,
			'SetupListener'		=>	\&SetupListener,
			'ListenerError'		=>	\&POE::Component::Server::SimpleHTTP::ListenerError,

			# Wheel::ReadWrite stuff
			'Got_Connection'	=>	\&Got_Connection,
			'Got_Input'		=>	\&Got_Input,
			'Got_Flush'		=>	\&Got_Flush,
			'Got_Error'		=>	\&Got_Error,

			# Send output to connection!
			'DONE'		=>	\&POE::Component::Server::SimpleHTTP::Request_Output,
                        
			# Stream output to connection!
			'STREAM'	   =>	\&POE::Component::Server::SimpleHTTP::Stream_Output,

			# Kill the connection!
			'CLOSE'		=>	\&Request_Close,
		},

		# Set up the heap for ourself
		'heap'		=>	{
			'ALIAS'			=>	$ALIAS,
			'ADDRESS'		=>	$ADDRESS,
			'PORT'			=>	$PORT,
			'HEADERS'		=>	$HEADERS,
			'HOSTNAME'		=>	$HOSTNAME,
			'HANDLERS'		=>	$HANDLERS,
			'REQUESTS'		=>	{},
			'RETRIES'		=>	0,
			'SSLKEYCERT'		=>	$SSLKEYCERT,
			'MINSPARESERVERS'	=>	$MINSPARESERVERS,
			'MAXSPARESERVERS'	=>	$MAXSPARESERVERS,
			'MAXCLIENTS'		=>	$MAXCLIENTS,
			'STARTSERVERS'		=>	$STARTSERVERS,
			'MAXREQUESTPERCHILD'	=>	$MAXREQUESTPERCHILD,
			'ISCHILD'		=>	0,
			'FORKHANDLERS'		=>	$FORKHANDLERS,
			'SCOREBOARD'		=>	undef
		},
	) or die 'Unable to create a new session!';

	# Return success
	return 1;
}

# Starts the server!
sub StartServer {
	# Settup our signal handlers
	$_[KERNEL]->sig( TERM => 'SigTERM' );
	$_[KERNEL]->sig( CHLD => 'SigCHLD' );

	# Call the super class method.
	return POE::Component::Server::SimpleHTTP::StartServer( @_ );
}

# Stops the server!
sub StopServer {
	my $children;

	# Shutdown the SocketFactory wheel
	if ( exists $_[HEAP]->{'SOCKETFACTORY'} ) {
		delete $_[HEAP]->{'SOCKETFACTORY'};
	}

	# Debug stuff
	if ( POE::Component::Server::SimpleHTTP::DEBUG ) {
		warn 'Stopped listening for new connections!';
	}

	# Are we gracefully shutting down or not?
	if ( defined $_[ARG0] and $_[ARG0] eq 'GRACEFUL' ) {
		# Attempt to gracefully kill the children.
		$children = $_[KERNEL]->call( $_[SESSION], 'KillChildren', 'TERM' );

		# Check for number of requests, and children.
		if ( (keys( %{ $_[HEAP]->{'REQUESTS'} } ) == 0) && ($children == 0) ) {
			# Alright, shutdown anyway

			# Delete our alias
			$_[KERNEL]->alias_remove( $_[HEAP]->{'ALIAS'} );

			# Destroy all memory segments created by this process.
			IPC::Shareable->clean_up;
			$_[HEAP]->{'SCOREBOARD'} = undef;

			# Debug stuff
			if ( POE::Component::Server::SimpleHTTP::DEBUG ) {
				warn 'Stopped SimpleHTTP gracefully, no requests left';
			}
            
		}

		# All done!
		return 1;
	}
    
    # CheckSpares need to know that we're shutting down
    $_[HEAP]->{'SCOREBOARD'}->{'shutdown'} = 1;
	
    # Forcefully kill all the children.
		$_[KERNEL]->call( $_[SESSION], 'KillChildren', 'KILL' );

		# Forcibly close all sockets that are open
		foreach my $conn ( keys %{ $_[HEAP]->{'REQUESTS'} } ) {
			# Can't call method "shutdown_input" on an undefined value at
			# /usr/lib/perl5/site_perl/5.8.2/POE/Component/Server/SimpleHTTP.pm line 323.
			if ( defined $_[HEAP]->{'REQUESTS'}->{ $conn }->[0] 
                and defined $_[HEAP]->{'REQUESTS'}->{ $conn }->[0]->[ POE::Wheel::ReadWrite::HANDLE_INPUT ] ) {
				$_[HEAP]->{'REQUESTS'}->{ $conn }->[0]->shutdown_input;
				$_[HEAP]->{'REQUESTS'}->{ $conn }->[0]->shutdown_output;
			}

			# Delete this request
			delete $_[HEAP]->{'REQUESTS'}->{ $conn };
		}

		# Remove any shared memory segments.
		IPC::Shareable->clean_up;
		$_[HEAP]->{'SCOREBOARD'} = undef;

		# Delete our alias
		$_[KERNEL]->alias_remove( $_[HEAP]->{'ALIAS'} );

	# Debug stuff
	if ( POE::Component::Server::SimpleHTTP::DEBUG ) {
		warn 'Successfully stopped SimpleHTTP';
	}

	# Return success
	return 1;
}

# Kill all our children, and return the number we sent signals too.
sub KillChildren {
	my ( $heap, $sig ) = @_[ HEAP, ARG0 ];
	my ( $children, $scoreboard, $mem ) = 0;

	# By default, kill them nicely.
	$sig = 'TERM' unless defined $sig;

	# Make sure we are the parent AND preforked.
	if ( $heap->{'ISCHILD'} == 0 ) {
		if ( POE::Component::Server::SimpleHTTP::DEBUG ) {
			warn "Killing children from $$ with signal $sig.";
		}

		$scoreboard = $heap->{'SCOREBOARD'};
		$mem = tied %$scoreboard;
		if ( not defined $mem ) {
			# There was an error, but there's nothing we can do,
			# so just exit.
			warn "Parent's SCOREBOARD is not tied!";
			$children = 0;
		} else {
			# Get a count of the number of children, and start killing them
			$mem->shlock( LOCK_SH );
			# The children haven't already received a signal, so send them one.
			foreach my $pid ( keys %$scoreboard ) {
				if ( ($pid ne 'actives') && ($pid ne 'spares') ) {
					++$children;
					kill $sig, $pid;
				}
			}
			$mem->shlock( LOCK_UN );

			# Check to make sure it is sane.
			if ( $children < 0 ) {
				warn "The child count is negative: $children.";
				$children = 0;
			}
		}
	}

	# 
	$_[KERNEL]->delay_set('CheckSpares');

	return $children;
}

# Sets up the SocketFactory wheel :)
sub SetupListener {
	# Debug stuff
	if ( POE::Component::Server::SimpleHTTP::DEBUG ) {
		warn 'Creating SocketFactory wheel now';
	}

	# Only try to re-establish the listener if we are the parent
	if ( $_[HEAP]->{'ISCHILD'} ) {
			warn 'Inside the child. Aborting attempt to reestablish the listener.';
		return 0;
	}

	# Check if we should set up the wheel
	if ( $_[HEAP]->{'RETRIES'} == POE::Component::Server::SimpleHTTP::MAX_RETRIES ) {
		die 'POE::Component::Server::SimpleHTTP::PreFork tried ' . POE::Component::Server::SimpleHTTP::MAX_RETRIES . ' times to create a Wheel and is giving up...';
	} else {
		# Increment the retry count if we did not get 'NOINC' as an argument
		if ( ! defined $_[ARG0] ) {
			# Increment the retries count
			$_[HEAP]->{'RETRIES'}++;
		}

		# Create our own SocketFactory Wheel :)
		$_[HEAP]->{'SOCKETFACTORY'} = POE::Wheel::SocketFactory->new(
			'BindPort'	=>	$_[HEAP]->{'PORT'},
			'BindAddress'	=>	$_[HEAP]->{'ADDRESS'},
			'Reuse'		=>	'yes',
			'SuccessEvent'	=>	'Got_Connection',
			'FailureEvent'	=>	'ListenerError',
		);

		# Pre-fork if that is what was requested
		if ( $_[HEAP]->{'STARTSERVERS'} ) {
			# We don't want to accept socket connections in the parent process
			$_[HEAP]->{'SOCKETFACTORY'}->pause_accept();

			# Wait a bit and then do the actual forking
			$_[KERNEL]->yield( 'PreFork', $_[HEAP]->{'SOCKETFACTORY'} );
		}
	}

	# Success!
	return 1;
}

# PreFork the initial instances.
sub PreFork {
	# ARG0 = SocketFactory
	my ( $kernel, $heap, $sf ) = @_[ KERNEL, HEAP, ARG0 ];
	my ( $scoreboard, $mem );

	if ( POE::Component::Server::SimpleHTTP::DEBUG ) {
		warn 'Trying to prefork.';
	}

	# Only the parent is allowed to fork
	if ( $heap->{'ISCHILD'} ) {
		warn "Cannot pre-fork from child $$.";
		return 0;
	}

	# Make that the current SF is the same as the one we were called for.
	# If not, then that means and error occured sometime inbetween.
	if ( (not defined $heap->{'SOCKETFACTORY'}) || ($sf != $heap->{'SOCKETFACTORY'}) ) {
		warn 'Aborting pre-fork because the SocketFactory is not the same.';
		return 0;
	}


	# Initialize the scoreboard the first time around.
	if ( not defined $heap->{'SCOREBOARD'} ) {
		my %temp;

		# In order to keep a pool of spare children we need to know how many spares there are.
		$mem = tie %temp, 'IPC::Shareable', 'scbd', { 'create' => 1, 'mode' => 0600 };
		$scoreboard = \%temp;
	} else {
		# We already have a scoreboard from a previous listen attempt.
		$scoreboard = $heap->{'SCOREBOARD'};
		$mem = tied %$scoreboard;
	}

	if ( not defined $mem ) {
		warn 'Cannot tie to the shared memory segment. Will try again in 5 seconds.';
		$kernel->delay_set( 'PreFork', PREFORK_INTERVAL, $sf );
		return 0;
	} else {
		# Clear the variable and store it for later use.
		%$scoreboard = ( 'spares' => 0, 'actives' => 0 );
		$heap->{'SCOREBOARD'} = $scoreboard;
	}

	for ( 1 .. $heap->{'STARTSERVERS'} ) {
		my $pid = fork();

		if ( not defined $pid ) {
			# Make sure this fork succeeded.
			warn "Server $$ fork failed: $!";
			next;
		} elsif ( $pid ) {
			# We are the parent.
			next;
		} else {
			if ( POE::Component::Server::SimpleHTTP::DEBUG ) {
				warn "Forked child $$.";
			}

			# We are the child. Do something "childish".
			$heap->{'ISCHILD'} = 1;
			$kernel->call( $_[SESSION], 'AddScoreboard' );

			# Notify the other forked sessions that we have forked.
			foreach my $sess ( keys( %{$heap->{'FORKHANDLERS'}} ) ) {
				$_[KERNEL]->call( $sess, $heap->{'FORKHANDLERS'}->{$sess} );
			}


			# Get to work!
			$sf->resume_accept();
			return 1;
		}
	}

	# Pre-forking is done and our children are happily away!
	# We are the parent, so start monitoring the spare pool.
	$kernel->delay_set( 'CheckSpares', CHECKSPARES_INTERVAL );

	# Let the developer see the scoreboard if they want.
	if ( DEBUGSB ) {
		$kernel->delay_set( 'ShowScoreboard', 1 );
	}
}

# True if this is a child.
sub IsChild {
	return $_[HEAP]->{'ISCHILD'};
}

# Check to see if we need a new spare.
sub CheckSpares {
	my ( $kernel, $heap ) = @_[ KERNEL, HEAP ];
	my ( $scoreboard, $mem );

	# Make sure that we are not a child.
	if ( $heap->{'ISCHILD'} ) {
		warn "Child $$ trying to check the spares!";
		return 0;
	}

	# Make sure there is still a socket factory. If not, then this server
	# is shutting down.
	if ( not defined $heap->{'SOCKETFACTORY'} ) {
		if ( POE::Component::Server::SimpleHTTP::DEBUG ) {
			warn 'Ending CheckSpares on the parent.';
		}
		return 1;
	}


	# Retrieve the shared memory variable.
	$scoreboard = $heap->{'SCOREBOARD'};

    # in the test for maxrequestperchild the only 
    # way to have CheckSpare aware that we're shutting down
    # is using this shared variable
    if (defined $scoreboard->{'shutdown'}) {
        if ( POE::Component::Server::SimpleHTTP::DEBUG ) {
            warn 'Shutdown in progress, checkspare is useless';
        }
        return 1;
    }

	$mem = tied %$scoreboard if defined $scoreboard;
	if ( not defined $mem ) {
		warn 'SCOREBOARD is not tied! Aborting.';
		return 0;
	}

	# Check to see if we need another spare, and if so make sure we don't
	# already have more than enough clients.
	$mem->shlock( LOCK_SH );
	if ( ($scoreboard->{'spares'} < $heap->{'MINSPARESERVERS'}) &&
	     ((keys( %$scoreboard ) - 2) < $heap->{'MAXCLIENTS'}) ) {
	     	$mem->shlock( LOCK_UN );
		my $pid = fork();

		if ( not defined $pid ) {
			warn 'fork failed while creating a new spare.';
		} elsif ( $pid ) {
			# We are the parent.
		} else {
			if ( POE::Component::Server::SimpleHTTP::DEBUG ) {
				warn "Created spare child $$.";
			}

			# We are the child. Do something "childish".
			$heap->{'ISCHILD'} = 1;
			$kernel->call( $_[SESSION], 'AddScoreboard' );

			# Notify the other forked sessions that we have forked.
			foreach my $sess ( keys( %{$heap->{'FORKHANDLERS'}} ) ) {
				$_[KERNEL]->call( $sess, $heap->{'FORKHANDLERS'}->{$sess} );
			}

			# Start accepting connections!
			$heap->{'SOCKETFACTORY'}->resume_accept();
		}
	} else {
		# No new spares were needed.
		$mem->shlock( LOCK_UN );
	}

	# If we are the parent, then reschedule another spare check.
	if ( $heap->{'ISCHILD'} == 0 ) {
		$kernel->delay_set( 'CheckSpares', CHECKSPARES_INTERVAL );
	}
}

# Debug routine so that we can watch what is happening on the scoreboard.
sub ShowScoreboard {
	my ( $heap ) = $_[ HEAP ];
	my ( $scoreboard, $mem, $hcount, $pid );

	# Check to make sure we are not a child.
	if ( $heap->{'ISCHILD'} ) {
		return 0;
	}

	# Check to make sure the scoreboard is still up.
	$scoreboard = $heap->{'SCOREBOARD'};
	if ( not defined $scoreboard ) {
		return 0;
	}

	# Retrieve the underlying class.
	$mem = tied %$scoreboard;
	if ( not defined $mem ) {
		warn 'SCOREBOARD is not tied! Aborting.';
		return 0;
	}

	# Lock the scoreboard and print out the entries.
	$mem->shlock( LOCK_SH );
	$hcount = 0;
	print STDERR "[$$] actives = ", $scoreboard->{'actives'}, "\tspares = ", $scoreboard->{'spares'}, "\n";
	foreach $pid ( keys %$scoreboard ) {
		next if ($pid eq 'actives') || ($pid eq 'spares');

		print STDERR $pid, " = ", $scoreboard->{$pid};
		if ( ++$hcount % 5 == 0 ) {
			print STDERR "\n";
		} else {
			print STDERR "\t";
		}
	}
	print STDERR "\n\n";
	$mem->shlock( LOCK_UN );

	# If the socketfactory still exists then we should continue looping.
	if ( exists $heap->{'SOCKETFACTORY'} ) {
		$_[KERNEL]->delay_set( 'ShowScoreboard', 1 );
	}
}

# A child died :(
sub SigCHLD {
	my ( $heap, $pid ) = @_[ HEAP, ARG1 ];
	my ( $scoreboard, $mem, $children );

	# Check to see if we are in preforked mode and the parent.
	if ( $heap->{'ISCHILD'} == 0 ) {
		# Retrieve our scoreboard.
		$scoreboard = $heap->{'SCOREBOARD'};
		$mem = tied %$scoreboard if defined $scoreboard;
		if ( not defined $mem ) {
			warn 'Cannot get the IPC::Shareable object for the SCOREBOARD!';
			return;
		}

		$mem->shlock( LOCK_EX );
		# Cleanup children here (they should never do it themselves).
			if ( exists $scoreboard->{$pid} ) {
				if ( $scoreboard->{$pid} eq 'S' ) {
					--$scoreboard->{'spares'};
				} elsif ( $scoreboard->{$pid} eq 'A' ) {
					--$scoreboard->{'actives'};
				}
				delete $scoreboard->{$pid};
			}

		# Get the number of children.
		$children = keys( %$scoreboard ) - 2;

		$mem->shlock( LOCK_UN );

		# If the children are dying and the SOCKETFACTORY no longer exists, then
		# we are probably in a graceful shutdown.
		if ( ($children <= 0) && (not exists $heap->{'SOCKETFACTORY'}) ) {
			$_[KERNEL]->yield( 'SHUTDOWN', 'GRACEFUL' );
		}
	}
}

# Someone is asking us to quit...
sub SigTERM {
	my ( $sig ) = $_[ ARG0 ];

	if ( POE::Component::Server::SimpleHTTP::DEBUG ) {
		warn "Caught signal ", $sig, " inside $$. Initiating graceful shutdown.";
	}

	# Shutdown gracefully, and tell POE we handled the signal.
	$_[KERNEL]->yield( 'SHUTDOWN', 'GRACEFUL' );
	$_[KERNEL]->sig_handled();
}

# Add the scoreboard entry for this child.
sub AddScoreboard {
	my ( $heap ) = $_[ HEAP ];
	my ( $scoreboard, $mem );

	# Check to see if we are preforked.
	if ( $heap->{'ISCHILD'} ) {
		$scoreboard = $heap->{'SCOREBOARD'};
		$mem = tied %$scoreboard if defined $scoreboard;
		if ( not defined $mem ) {
			# Don't do anyting if we can't lock stuff.
			warn "SCOREBOARD is not tied to IPC::Shareable in child $$!";
		} else {
			# Lock the scoreboard and record ourself properly.
			$mem->shlock( LOCK_EX );
			if ( not exists $scoreboard->{$$} ) {
				$scoreboard->{$$} = 'S';
				++$scoreboard->{'spares'};
			}
			$mem->shlock( LOCK_UN );
		}
	}

	return 1;
}

# Set the scoreboard entry for this child.
sub UpdateScoreboard {
	my ( $heap ) = $_[ HEAP ];
	my ( $scoreboard, $mem );

	# Check to see if we are preforked.
	if ( $heap->{'ISCHILD'} ) {
		$scoreboard = $heap->{'SCOREBOARD'};
		$mem = tied %$scoreboard if defined $scoreboard;
		if ( not defined $mem ) {
			# Don't do anyting if we can't lock stuff.
			warn "SCOREBOARD is not tied to IPC::Shareable in child $$!";
		} else {
			# Lock the scoreboard and record ourself properly.
			$mem->shlock( LOCK_EX );
			if ( (keys( %{$heap->{'REQUESTS'}} ) == 0) && ($scoreboard->{$$} eq 'A') ) {
				$scoreboard->{$$} = 'S';
				++$scoreboard->{'spares'};
				--$scoreboard->{'actives'};

				# If we have too many spares then ask this one to shutdown.
				if ( $scoreboard->{'spares'} > $heap->{'MAXSPARESERVERS'} ) {
					if ( POE::Component::Server::SimpleHTTP::DEBUG ) {
						warn "Shutting down $$ because of too many spares.";
					}

					$_[KERNEL]->yield( 'SHUTDOWN', 'GRACEFUL' );
				}
			} elsif ( (keys( %{$heap->{'REQUESTS'}} ) != 0) && ($scoreboard->{$$} eq 'S') ) {
				$scoreboard->{$$} = 'A';
				--$scoreboard->{'spares'};
				++$scoreboard->{'actives'};
			}
			$mem->shlock( LOCK_UN );
		}
	}

	return 1;
}

# Stops listening on the socket
sub StopListen {
	if ( $_[HEAP]->{'ISCHILD'} ) {
		# If we are the child then we shouldn't really stop listening.
		# Instead, pause accepting on our SocketFactory.
		if ( (not exists $_[HEAP]->{'SOCKETFACTORY'}) || (not defined $_[HEAP]->{'SOCKETFACTORY'} ) ) {
			warn "Cannot StopListen on a non-existant SOCKETFACTORY in child $$";
			return 0;
		} else {
			# Pause accepting.
			$_[HEAP]->{'SOCKETFACTORY'}->pause_accept();
			return 1;
		}
	} else {
		# We are in the parent, so truly stop listening.
		# Kill the children because they are still listenning.
		$_[KERNEL]->call( $_[SESSION], 'KillChildren', 'TERM' );

		# Call the super class method.
		return POE::Component::Server::SimpleHTTP::StopListen( @_ );
	}
}

sub StartListen {
	if ( $_[HEAP]->{'ISCHILD'} ) {
		# If we are the child then we can't really create a new SOCKETFACTORY.
		# Instead, we can resume accepting on our current SOCKETFACTORY.
		if ( (not exists $_[HEAP]->{'SOCKETFACTORY'}) || (not defined $_[HEAP]->{'SOCKETFACTORY'} ) ) {
			warn "Cannot StartListen on a non-existant SOCKETFACTORY in child $$";
			return 0;
		} else {
			# Resume accepting.
			$_[HEAP]->{'SOCKETFACTORY'}->resume_accept();
			return 1;
		}
	} else {
		# We are the parent. Truly start listening again.
		return POE::Component::Server::SimpleHTTP::StartListen( @_ );
	}
}

# Sets the HANDLERS
sub SetHandlers {
	# Setting handlers in a child makes little sense, so abort if this is the case
	if ( $_[HEAP]->{'ISCHILD'} ) {
		warn "Child $$ tried to set the handlers for SimpleHTTP.";
		return 0;
	}

	# Call the super class method.
	return POE::Component::Server::SimpleHTTP::SetHandlers( @_ );
}

# Sets the FORKHANDLERS
sub SetForkHandlers {
	# ARG0 = ref to handlers hash
	my $handlers = $_[ARG0];

	# Setting handlers in a child makes little sense, so abort if this is the case.
	if ( $_[HEAP]->{'ISCHILD'} ) {
		warn "Child $$ tried to set the handlers for SimpleHTTP.";
		return 0;
	}

	# Validate it...
	if ( (not defined $handlers) || (ref( $handlers ) ne 'HASH') ) {
		warn "FORKHANDLERS is not in the proper format.";
		return 0;
	}

	# If we got here, passed tests!
	$_[HEAP]->{'FORKHANDLERS'} = $handlers;

	# All done!
	return 1;
}

# Gets the FORKHANDLERS
sub GetForkHandlers {
	# ARG0 = session, ARG1 = event
	my( $session, $event ) = @_[ ARG0, ARG1 ];

	# Validation
	if ( ! defined $session or ! defined $event ) {
		return undef;
	}

	# Make a deep copy of the handlers
	require Storable;

	my $handlers = Storable::dclone( $_[HEAP]->{'FORKHANDLERS'} );

	# All done!
	$_[KERNEL]->post( $session, $event, $handlers );

	# All done!
	return 1;
}

# The actual manager of connections
sub Got_Connection {
	# ARG0 = Socket, ARG1 = Remote Address, ARG2 = Remote Port
	my ( $socket ) = $_[ ARG0 ];

	# Should we SSLify it?
	if ( defined $_[HEAP]->{'SSLKEYCERT'} ) {
		# SSLify it!
		eval { $socket = Server_SSLify( $socket ) };
		if ( $@ ) {
			warn "Unable to turn on SSL for connection from " . Socket::inet_ntoa( $_[ARG1] ) . " -> $@";
			close $socket;
			return 1;
		}
	}

	# Set up the Wheel to read from the socket
	my $wheel = POE::Wheel::ReadWrite->new(
		'Handle'	=>	$socket,
		'Driver'	=>	POE::Driver::SysRW->new(),
		'Filter'	=>	POE::Filter::HTTPD->new(),
		'InputEvent'	=>	'Got_Input',
		'FlushedEvent'	=>	'Got_Flush',
		'ErrorEvent'	=>	'Got_Error',
	);

	# Save this wheel!
	# 0 = wheel, 1 = Output done?, 2 = SimpleHTTP::Response object
	$_[HEAP]->{'REQUESTS'}->{ $wheel->ID } = [ $wheel, 0, undef ];

	# Update the scoreboard.
	$_[KERNEL]->call( $_[SESSION], 'UpdateScoreboard' );

	# Debug stuff
	if ( POE::Component::Server::SimpleHTTP::DEBUG ) {
		warn "Got_Connection completed creation of ReadWrite wheel ( " . $wheel->ID . " )";
	}

	# Success!
	return 1;
}

# Finally got input, set some stuff and send away!
sub Got_Input {
	# ARG0 = HTTP::Request object, ARG1 = Wheel ID
	my ( $request, $id ) = @_[ ARG0, ARG1 ];

	# Call the super class method.
	my $rv = POE::Component::Server::SimpleHTTP::Got_Input( @_ );

	# If the connection died/failed for some reason then the request is deleted.
	# In this case, we have to update the scoreboard.
	if ( not exists $_[HEAP]->{'REQUESTS'}->{ $id } ) {
		$_[KERNEL]->call( $_[SESSION], 'UpdateScoreboard' );
	}

	return $rv;
}

# Finished with a request!
sub Got_Flush {
	# ARG0 = wheel ID
	my ( $id ) = $_[ ARG0 ];

	# Call the super class method.
	my $rv = POE::Component::Server::SimpleHTTP::Got_Flush( @_ );

	# Deal with maxrequestperchild
	if ( $_[HEAP]->{'ISCHILD'} && defined $_[HEAP]->{'MAXREQUESTPERCHILD'}) {
                $_[HEAP]->{'REQUESTCOUNT'}++;
                
                if ($_[HEAP]->{'REQUESTCOUNT'} >= $_[HEAP]->{'MAXREQUESTPERCHILD'}) {
                  
                  if ( POE::Component::Server::SimpleHTTP::DEBUG ) {
                          warn "Shutting down $$ because it reached MAXREQUESTPERCHILD.";
                  }
                  
                  $_[KERNEL]->yield( 'SHUTDOWN', 'GRACEFUL' );
                  return 1;
               }
	}
        
	# If the connection died/failed for some reason then the request is deleted.
	# In this case, we have to update the scoreboard.
	if ( not exists $_[HEAP]->{'REQUESTS'}->{ $id } ) {
		$_[KERNEL]->call( $_[SESSION], 'UpdateScoreboard' );
	}

	return $rv;
}

# Got some sort of error from ReadWrite
sub Got_Error {
	# Call the super class method.
	my $rv = POE::Component::Server::SimpleHTTP::Got_Error( @_ );

	# The connection was probably cleared, so update the scoreboard.
	$_[KERNEL]->call( $_[SESSION], 'UpdateScoreboard' );

	return $rv;
}

# Closes the connection
sub Request_Close {
	# Call the super class method.
	my $rv = POE::Component::Server::SimpleHTTP::Request_Close( @_ );

	# The connection was probably cleared, so update the scoreboard.
		$_[KERNEL]->call( $_[SESSION], 'UpdateScoreboard' );

	return $rv;
}

# End of module
1;

__END__
=head1 NAME

POE::Component::Server::SimpleHTTP::PreFork - PreForking support for SimpleHTTP

=head1 SYNOPSIS

	use POE;
	use POE::Component::Server::SimpleHTTP::PreFork;

	# Start the server!
	POE::Component::Server::SimpleHTTP::PreFork->new(
		'ALIAS'		=>	'HTTPD',
		'ADDRESS'	=>	'192.168.1.1',
		'PORT'		=>	11111,
		'HOSTNAME'	=>	'MySite.com',
		'HANDLERS'	=>	[
			{
				'DIR'		=>	'^/bar/.*',
				'SESSION'	=>	'HTTP_GET',
				'EVENT'		=>	'GOT_BAR',
			},
			{
				'DIR'		=>	'^/$',
				'SESSION'	=>	'HTTP_GET',
				'EVENT'		=>	'GOT_MAIN',
			},
			{
				'DIR'		=>	'^/foo/.*',
				'SESSION'	=>	'HTTP_GET',
				'EVENT'		=>	'GOT_NULL',
			},
			{
				'DIR'		=>	'.*',
				'SESSION'	=>	'HTTP_GET',
				'EVENT'		=>	'GOT_ERROR',
			},
		],

		# In the testing phase...
		'SSLKEYCERT'		=>	[ 'public-key.pem', 'public-cert.pem' ],

		# In the testing phase...
		'FORKHANDLERS'		=>	{ 'HTTP_GET' => 'FORKED' },
		'MINSPARESERVERS'	=>	5,
		'MAXSPARESERVERS'	=>	10,
		'MAXCLIENTS'		=>	256,
		'STARTSERVERS'		=>	10,
	) or die 'Unable to create the HTTP Server';

=head1 ABSTRACT

	Subclass of SimpleHTTP for PreForking support

=head1 New Constructor Options

=over 5

=item C<MINSPARESERVERS>

	An integer that tells the server how many spares should be in the pool at any given
	time. Processes are forked off at a rate of 1 a second until this limit is met.

=item C<MAXSPARESERVERS>

	An integer that tells the server the maximum number of spares that may be in the pool
	at any given time. It is possible for more than this number of spares to exist, but at the very
	least the parent will stop forking requests off and the children will start to die eventually.

	If this value is less than MINSPARESERVERS then it is set to MINSPARESERVERS + 1.

=item C<MAXCLIENTS>

	An integer that tells the server the maximum number of clients that will be
	created. After this limit is reached, no more spares will be forked, even if the number drops below
	MINSPARESERVERS.

=item C<STARTSERVERS>

	An integer that tells the server how many processes to prefork at startup.

=item C<FORKHANDLERS>

	A HASH where the keys are sessions and the values are events. When a child forks,
	before it begins accepting connections it will call these events on the specified
	sessions. This allows you to setup per-process resources (such as database
	connections, ldap connects, etc). These events will never be called for the
	parent.

=back

=head2 New Events

=over 4

=item C<ISCHILD>

	Returns true if you are inside a child, false if you are in the parent.

=item C<GETFORKHANDLERS>

	This event accepts 2 arguments: the session + event to send the response to.

	This even will send back the current FORKHANDLERS hash ( deep-closed via
	Storable::dclone ).

	The resulting hash can be played around to your tastes, then once you are done...

=item C<SETFORKHANDLERS>

	This event accepts only one argument: reference to FORKHANDLERS hash.

	BEWARE: this event is disabled in a forked child.

=back

=head1 Miscellaneous Notes

	BEWARE: HANDLERS munging is disabled in a forked child. Also, handlers changed in
	the parent will not appear in the already forked children.

	BEWARE: for a child, calling {STOP,START}LISTEN does not {destroy,recreate} the
	SOCKETFACTORY like it does in the parent. Instead, the child will {pause,resume}
	accepting connections on the current SOCKETFACTORY. Also, {STOP,START}LISTEN does
	not have any effect on the scoreboard calculations: this child will still
	be marked a spare if it finishes all its requests.

	The shutdown event is altered a little bit
		GRACEFUL -> sends a TERM signal to all remaining children and waits for their death
		NOARGS -> kills all remaining children with prejudice

	Keep in mind that being forked means any global data is not shared between processes and etc. Please see perlfork for all the implications on your platform.

=head1 New Compile-time constants

Checking spares every second may be a bit too much for you.
You can override this behavior by doing this:

	sub POE::Component::Server::SimpleHTTP::PreFork::CHECKSPARES_INTERVAL () { 10 }
	use POE::Component::Server::SimpleHTTP::PreFork;

If the prefork failed because it could not obtain shared memory for the scoreboard,
then if retries after 5 seconds. You can override this behavior by doing this:

	sub POE::Component::Server::SimpleHTTP::PreFork::PREFORK_INTERVAL () { 10 }
	use POE::Component::Server::SimpleHTTP::PreFork;

If you would like to see the contents of the scoreboard every second then do this:

	sub POE::Component::Server::SimpleHTTP::PreFork::DEBUGSB () { 1 }
	use POE::Component::Server::SimpleHTTP::PreFork;

=head2 EXPORT

Nothing.

=head1 SEE ALSO

	L<POE::Component::Server::SimpleHTTP>

=head1 AUTHOR

Apocalypse E<lt>apocal@cpan.orgE<gt>
Stephen Butler E<lt>stephen.butler@gmail.comE<gt>

=head1 COPYRIGHT AND LICENSE

Copyright 2006 by Apocalypse + Stephen Butler

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.

=cut
