view release on metacpan or  search on metacpan

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

</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;
    
    my @modules       =   grep /^\s*(Add|Load)Module/, @lines;
    my ($server_root) = (map /^\s*ServerRoot\s*(\S+)/, @lines);
    $server_root =~ s/^"//;
    $server_root =~ s/"$//;

    # Rewrite all modules to load from an absolute path.
    foreach (@modules) {
	s!(\s)([^/\s]\S+/)!$1$server_root/$2!;
    }
    
    my $static_mods = $self->static_modules('t/httpd');
    
    my @load;
    # Have to make sure that dir, autoindex and perl are loaded.
    foreach my $module (qw(dir autoindex perl)) {
       unless ($static_mods->{"mod_$module"} or grep /$module/i, @modules) {
           warn "Will attempt to load mod_$module dynamically.\n";
	    push @load, $module;
	}
    }
    
    # Directories where apache DSOs live.
    my @module_dirs = map {m,(/\S*/),} @modules;
    
    # Finally compute the directives to load modules that need to be loaded.
 MODULE:
    foreach my $module (@load) {
	foreach my $module_dir (@module_dirs) {
           foreach my $filename ("mod_$module.so", "lib$module.so", "ApacheModule\u$module.dll") {
               if (-e "$module_dir/$filename") {
                   push @modules, "LoadModule ${module}_module $module_dir/$filename\n"; next MODULE;
               }
	    }
	}
       warn "Warning: couldn't find anything to load for 'mod_$module'.\n";
    }
    
    print "Adding the following dynamic config lines: \n@modules";
    return join '', @modules;
}

sub static_modules {
    # Returns a hashref whose keys are each of the modules compiled
    # statically into the given httpd binary.