view release on metacpan or  search on metacpan

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

	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.
    my ($self, $httpd) = @_;

    my @l = `$httpd -l`;
    return {map {lc($_) => 1} map /(\S+)\.c/, @l};
}

# Find an executable in the PATH.
sub which {
    foreach (map { "$_/$_[0]" } split /:/, $ENV{PATH}) {
	next unless m,^/,;
	return $_ if -x;
    }
}

sub test { 
    shift() if UNIVERSAL::isa($_[0], __PACKAGE__);
    my $s = $_[1] ? "ok $_[0]\n" : "not ok $_[0]\n";
    if($ENV{MOD_PERL}) {
	Apache->request->print($s);
    }
    else {
	print $s;
    }
}

sub fetch {
    # Old code calls fetch() as a function, new code as a method
    my $want_response;
    $want_response = shift() if UNIVERSAL::isa($_[0], __PACKAGE__);
    my ($ua, $url) = (@_ == 1 ? ($UA, shift()) : @_);
    my $request = ref $url ? $url : {uri=>$url};

    # Set some defaults
    $ENV{PORT} ||= 8529;  # For mod_perl's own tests
    $request->{method} ||= 'GET';
    $request->{content} = '' unless exists $request->{content};
    $request->{uri} = "http://localhost:$ENV{PORT}$request->{uri}"    
	unless $request->{uri} =~ /^http/;
    $request->{headers}{Content_Type} = 'application/x-www-form-urlencoded'
	if (!$request->{headers} and $request->{method} eq 'POST');  # Is this necessary?

    # Create & send the request
    $request->{headers} = new HTTP::Headers(%{$request->{headers}||{}});
    my $req = new HTTP::Request(@{$request}{'method','uri','headers','content'});
    my $response = $ua->request($req);

    return $want_response ? $response : $response->content;
}

sub simple_fetch {
    my $ua = LWP::UserAgent->new;
    my $url = URI::URL->new("http://$net::httpserver");
    my($path,$q) = split /\?/, shift; 
    $url->path($path);
    $url->query($q) if $q;
    my $request = new HTTP::Request('GET', $url);
    my $response = $ua->request($request, undef, undef);   
    $response->is_success;
}

#even if eval $mod fails, the .pm ends up in %INC
#so the next eval $mod succeeds, when it shouldnot

my %really_have = (
   'Apache::Table' => sub { 
       if ($ENV{MOD_PERL}) {
	   return Apache::Table->can('TIEHASH');
       }
       else {
	   return $net::callback_hooks{PERL_TABLE_API};
       }
   },
);

for (qw(Apache::Cookie Apache::Request)) {
    $really_have{$_} = $really_have{'Apache::Table'};
}

sub have_module {
    my $mod = shift;
    my $v = shift;
    eval {# surpress "can't boostrap" warnings
	 local $SIG{__WARN__} = sub {};
	 require Apache;
	 require Apache::Constants;
    };

    eval "require $mod";
    if($v and not $@) {
	eval { 
	    local $SIG{__WARN__} = sub {};
	    $mod->UNIVERSAL::VERSION($v);
	};
	if($@) {
	    warn $@;
	    return 0;
	}
    }
    if($@ && ($@ =~ /Can.t locate/)) {
	return 0;
    }
    elsif($@ && ($@ =~ /Can.t find loadable object for module/)) {
	return 0;
    }
    elsif($@) {
	warn "$@\n";
    }

    if (my $cv = $really_have{$mod}) {
	return 0 unless $cv->();
    }

    print "module $mod is installed\n" unless $ENV{MOD_PERL};
    
    return 1;
}