view release on metacpan or  search on metacpan

t/lib/Apache/test.pm  view on Meta::CPAN

$USE_SFIO = (($Config{'usesfio'} || '') eq 'true');

my $Is_Win32 = ($^O eq "MSWin32");
sub WIN32 () { $Is_Win32 };

my $UA;

eval {
    require LWP::UserAgent;
    $UA = LWP::UserAgent->new;
};

unless (defined &Apache::bootstrap) {
    *Apache::bootstrap = sub {};
    *Apache::Constants::bootstrap = sub {};
}

sub write_httpd_conf {
    my $pkg = shift;
    return unless &have_httpd;
    my %args = (conf_file => 't/httpd.conf', @_);
    my $DIR = `pwd`; chomp $DIR;

    local *CONF;
    open CONF, ">$args{conf_file}" or die "Can't create $args{conf_file}: $!";
    print CONF <<EOF;

Port $args{port}
User $args{user}
Group $args{group}
ServerName localhost
DocumentRoot $DIR/t

$args{modules}

ErrorLog $DIR/t/error_log
PidFile $DIR/t/httpd.pid
AccessConfig /dev/null
ResourceConfig /dev/null
LockFile $DIR/t/httpd.lock
TypesConfig /dev/null
TransferLog /dev/null
ScoreBoardFile /dev/null

AddType text/html .html

# Look in ./blib/lib
<Perl>
 use blib '$DIR';
 use lib  '$DIR/t/lib';
</Perl>

$args{include}
EOF

    return 1;
}

sub _ask {
    # Just a function for asking the user questions
    my ($prompt, $default, $mustfind, $canskip) = @_;

    my $skip = defined $canskip ? " ('$canskip' to skip)" : '';
    my $response;
    do {
	print "$prompt [$default]$skip: ";
	chomp($response = <STDIN>);
	$response ||= $default;
    } until (!$mustfind || ($response eq $canskip) || (-e $response || !print("$response not found\n")));

    return $response;
}

sub get_test_params {
    my $pkg = shift;

    print("\nFor testing purposes, please give the full path to an httpd\n",
	  "with mod_perl enabled.  The path defaults to \$ENV{APACHE}, if present.");
    
    my %conf;
    
    my $httpd = $ENV{'APACHE'} || which('apache') || which('httpd') || '/usr/lib/httpd/httpd';

    $httpd = _ask("\n", $httpd, 1, '!');
    if ($httpd eq '!') {
	print "Skipping.\n";
	return;
    }
    system "$Config{lns} $httpd t/httpd";

    # Default: search for dynamic dependencies if mod_so is present, don't bother otherwise.
    my $default = (`t/httpd -l` =~ /mod_so\.c/ ? 'y' : 'n');
    if (lc _ask("Search existing config file for dynamic module dependencies?", $default) eq 'y') {
	my %compiled;
	for (`t/httpd -V`) {
	    if (/([\w]+)="(.*)"/) {
		$compiled{$1} = $2;
	    }
	}
	$compiled{SERVER_CONFIG_FILE} =~ s,^,$compiled{HTTPD_ROOT}/,
	    unless $compiled{SERVER_CONFIG_FILE} =~ m,^/,;
	
	my $file = _ask("  Config file", $compiled{SERVER_CONFIG_FILE}, 1);
	$conf{modules} = $pkg->_read_existing_conf($file);
    }

    # Get default user (apache doesn't like to run as root, special-case it)
    my $defuser = ($< && getpwuid $<) || 'nobody';
    $conf{user} = _ask("User to run tests under", $defuser);

    my $defgroup = ($defuser eq 'nobody' ? 'nobody' : getgrgid((getpwnam $conf{user})[3]));
    $conf{group} = _ask("Group to run tests under", $defgroup);

    $conf{port} = _ask("Port to run tests under", 8228);

    return %conf;
}

sub _read_existing_conf {
    # Returns some "(Add|Load)Module" config lines, generated from the
    # existing config file and a few must-have modules.
    my ($self, $server_conf) = @_;
    
    open SERVER_CONF, $server_conf or die "Couldn't open $server_conf: $!";
    my @lines = grep {!m/^\s*\#/} <SERVER_CONF>;
    close SERVER_CONF;