view release on metacpan or  search on metacpan

lib/Apache/TestConfig.pm  view on Meta::CPAN

sub preamble_register {
    push @{ shift->{preamble_hooks} }, @_;
}

sub add_config_hooks_run {
    my($self, $where, $out) = @_;

    for (@{ $self->{"${where}_hooks"} }) {
        if ((ref($_) and ref($_) eq 'CODE') or $self->can($_)) {
            $self->$_();
        }
        else {
            error "cannot run configure hook: `$_'";
        }
    }

    for (@{ $self->{$where} }) {
        $self->replace;
        s/\n?$/\n/;
        print $out "$_";
    }
}

sub postamble_run {
    shift->add_config_hooks_run(postamble => @_);
}

sub preamble_run {
    shift->add_config_hooks_run(preamble => @_);
}

sub default_group {
    return if WINFU;

    my $gid = $);

    #use only first value if $) contains more than one
    $gid =~ s/^(\d+).*$/$1/;

    my $group = $ENV{APACHE_TEST_GROUP} || (getgrgid($gid) || "#$gid");

    if ($group eq 'root') {
        # similar to default_user, we want to avoid perms problems,
        # when the server is started with group 'root'. When running
        # under group root it may fail to create dirs and files,
        # writable only by user
        my $user = default_user();
        my $gid = $user ? (getpwnam($user))[3] : '';
        $group = (getgrgid($gid) || "#$gid") if $gid;
    }

    $group;
}

sub default_user {
    return if WINFU;

    my $uid = $>;

    my $user = $ENV{APACHE_TEST_USER} || (getpwuid($uid) || "#$uid");

    if ($user eq 'root') {
        my $other = (getpwnam('nobody'))[0];
        if ($other) {
            $user = $other;
        }
        else {
            die "cannot run tests as User root";
            #XXX: prompt for another username
        }
    }

    return $user;
}

sub default_serveradmin {
    my $vars = shift->{vars};
    join '@', ($vars->{user} || 'unknown'), $vars->{servername};
}

sub default_apxs {
    my $self = shift;

    return $self->{vars}->{apxs} if $self->{vars}->{apxs};

    if (my $build_config = $self->modperl_build_config()) {
        return $build_config->{MP_APXS};
    }

    if ($ENV{APACHE_TEST_APXS}) {
        return $ENV{APACHE_TEST_APXS};
    }

    # look in PATH as a last resort
    if (my $apxs = which('apxs')) {
        return $apxs;
    } elsif ($apxs = which('apxs2')) {
        return $apxs;
    }
    
    return;
}

sub default_httpd {
    my $self = shift;

    my $vars = $self->{vars};

    if (my $build_config = $self->modperl_build_config()) {
        if (my $p = $build_config->{MP_AP_PREFIX}) {
            for my $bindir (qw(bin sbin)) {
                my $httpd = catfile $p, $bindir, $vars->{target};
                return $httpd if -e $httpd;
                # The executable on Win32 in Apache/2.2 is httpd.exe,
                # so try that if Apache.exe doesn't exist
                if (WIN32) {
                    $httpd = catfile $p, $bindir, 'httpd.EXE';
                    if (-e $httpd) {
                        $vars->{target} = 'httpd.EXE';
                        return $httpd;