The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
package
	Apache::forks::Common;	# hide from PAUSE

$VERSION = 0.03;

# Abstract class 

use strict;
use warnings;
use Carp ();

use constant BASE => '';	#to be set in concrete class definition

use constant MP2 => (exists $ENV{MOD_PERL_API_VERSION} &&
                     $ENV{MOD_PERL_API_VERSION} == 2) ? 1 : 0;
my @Import;
our $DEBUG = 0;
my $BASE;

BEGIN {
	if (MP2) {
		require mod_perl2;
		require Apache2::MPM;
		require Apache2::Module;
		require Apache2::ServerUtil;
	}
	else {
		require mod_perl;
		if (defined $mod_perl::VERSION && $mod_perl::VERSION > 1 &&
			$mod_perl::VERSION < 1.99) {
			require Apache;

			#not using Apache::fork support yet (may be non-portable and/or deprecated)
#			require Apache::fork;
#			Apache::fork::forkoption(1);
#			no warnings 'redefine';
#			*threads::_fork = \&Apache::fork::fork;
		} else {
			die "Apache.pm is unavailable or unsupported version ($mod_perl::VERSION)";
		}
	}
}

### functions ###
sub DEBUG { $DEBUG = shift() ? 1 : 0; }

sub debug {
	print STDERR "$_[1]\n" if $DEBUG >= $_[0] || threads->debug >= $_[0];
}

sub _load_forks {
	my $self = shift;
	$BASE = $self->BASE;
	$forks::DEFER_INIT_BEGIN_REQUIRE = 1;
	eval 'require '.$self->_forks();
	die "forks version 0.26 or later required--this is only version $forks::VERSION"
		unless defined($forks::VERSION) && $forks::VERSION >= 0.26;
	eval 'import '.$self->_forks();	#set environment and preload server process
	eval 'require '.$self->_forks_shared();
	eval 'import '.$self->_forks_shared();	#set environment
	
	{
		no warnings 'redefine';
		my $old_server_pre_startup = \&threads::_server_pre_startup;
		*threads::_server_pre_startup = sub {
			unless ($self->DEBUG) {
				### close IO pipes to silence possible warnings to terminal ###
				close(STDERR);
				close(STDOUT);
				close(STDIN);
			}
			$old_server_pre_startup->()
				if ref($old_server_pre_startup) eq 'CODE';
		};
	}
}

sub childinit {
	threads->isthread;
	my $timestamp = localtime(time);
	debug(1, "[$timestamp] [notice] $$:".threads->tid
		." Apache::$BASE PerlChildInitHandler executed");

	1;
}

### methods ###
sub _forks { return shift->BASE; }

sub _forks_shared { return shift->BASE.'::shared'; }

sub import {
	my $self = shift;
	$self->_forks->import(@_);
	$self->_forks_shared->import();	#kludge: insures correct %INC for forks::shared

	my $timestamp = localtime(time);
	if (MP2) {
		if (!@Import) {
			Carp::carp("Apache MPM '".Apache2::MPM->show()
				."' is not supported: "
				."This package can't be used under threaded MPMs: "
				."Only 'Prefork' MPM is supported at this time\n")
			and return if Apache2::MPM->is_threaded;
			
			my $s = Apache2::ServerUtil->server;
			$s->push_handlers(PerlChildInitHandler => \&childinit);
			debug(1, "[$timestamp] [notice] $$:".threads->tid
				." Apache::".$self->_forks." PerlChildInitHandler enabled");
		}
	} else {
		Carp::carp("Apache.pm was not loaded\n")
		and return unless $INC{'Apache.pm'};

		if (!@Import and Apache->can('push_handlers')) {
			Apache->push_handlers(PerlChildInitHandler => \&childinit);
			debug(1, "[$timestamp] [notice] $$:".threads->tid
				." Apache::".$self->_forks." PerlChildInitHandler enabled");
		}
	}

	push @Import, [@_];
}

package
	Apache::forks::common::shared;	# hide from PAUSE

sub import {
	my $self = shift;
	$self->_forks_shared->import(@_);
}

1;