view release on metacpan or  search on metacpan

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

package Apache::test;

use strict;
use vars qw(@EXPORT $USE_THREAD $USE_SFIO $PERL_DIR);
use Exporter ();
use Config;
use FileHandle ();
*import = \&Exporter::import;

@EXPORT = qw(test fetch simple_fetch have_module skip_test 
	     $USE_THREAD $USE_SFIO $PERL_DIR WIN32 grab run_test); 

BEGIN { 
    if(not $ENV{MOD_PERL}) {
	eval { require "net/config.pl"; }; #for 'make test'
	$PERL_DIR = $net::perldir;
    } 
    if ($net::httpserver) {
	# Validate that the OS knows the name of the server in $net::httpserver     
	# if 'localhost' is not defined, the tests wouldn't pass
	(my $hostname) = ($net::httpserver =~ /(.*?):/);
	warn qq{\n*** [Crucial] You must define "$hostname" (e.g. in /etc/hosts) in order for 'make test' to pass\n}  
	unless gethostbyname $hostname;
    }
}

$PERL_DIR = $ENV{PERL_DIR} if exists $ENV{PERL_DIR};

$USE_THREAD = ($Config{extensions} =~ /Thread/) || $Config{usethreads};
$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;
    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
#PerlModule ExtUtils::testlib
<Perl>
 use lib "$DIR/blib/lib", "$DIR/t/lib";
</Perl>

$args{include}
EOF

    return 1;
}

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