view release on metacpan or  search on metacpan

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

    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 = $pkg->_find_mod_perl_httpd(1);

    my $found;
    do
    {
        $httpd = _ask("\n", $httpd, 1, '!');
        if ($httpd eq '!') {
            print "Skipping.\n";
            return;
        }

        if ($pkg->_httpd_has_mod_perl($httpd)) {
            $found = 1;
        } else {
            warn("$httpd does not appear to have been compiled with\n",
                 "mod_perl as a static or dynamic module\n");
            $httpd = $pkg->_find_mod_perl_httpd(0);
        }
    } until ($found);
    system "$Config{lns} $httpd t/httpd";
    $conf{httpd} = $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 = $pkg->get_compilation_params('t/httpd');

        $conf{version} = $compiled{SERVER_VERSION};
        $conf{config_file} = _ask("  Config file", $compiled{SERVER_CONFIG_FILE}, 1);
        $conf{modules} = $pkg->_read_existing_conf($conf{config_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 get_compilation_params {
    my ($self, $httpd) = @_;

    my %compiled;
    for (`$httpd -V`) {
        if (/([\w]+)="(.*)"/) {
            $compiled{$1} = $2;
        }
        if (/Server version: .*?([\d\.]+)/i) {
            $compiled{SERVER_VERSION} = $1;
        }
    }
    $compiled{SERVER_CONFIG_FILE} =~ s,^,$compiled{HTTPD_ROOT}/,
        unless $compiled{SERVER_CONFIG_FILE} =~ m,^/,;

    return %compiled;
}

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, $default_root, $is_include) = @_;

    open SERVER_CONF, $server_conf or die "Couldn't open $server_conf: $!";
    my @lines = grep {!m/^\s*\#/} <SERVER_CONF>;
    close SERVER_CONF;

    my ($server_root) = (map /^\s*ServerRoot\s*(\S+)/, @lines);
    $server_root =~ s/^"//;
    $server_root =~ s/"$//;

    $server_root ||= $default_root;

    my @includes;
    foreach my $include (grep /^\s*Include\s+\S+/, @lines) {
        my ($file) = $include =~ /^\s*Include\s+(\S+)/;
        $file =~ s/^"//;
        $file =~ s/"//;
        $file =~ s!^([^/])!$server_root/$1!;  # absolute path

        if ($file =~ m/\*/) {
            # expand wildcard includes (used in Fedora Core 1 default config)
            my @add = glob $file;
            unless ($Apache::test::quiet) {
                warn "expanding wildcard Include $file\n";
                warn "ADDED INC $_\n" for @add;
            }
            push @includes, @add;
        } else {
            push @includes, $file;