tags/v1_29/t/net/perl/hooks.pl

#!perl
use Apache ();
my $tests = 0;

my $r = Apache->request;
$r->content_type("text/html");
$r->send_http_header;
my $doc_root = $r->document_root;

my $ht_access  = "$doc_root/.htaccess";
my $hooks_file = "$doc_root/hooks.txt";

sub wipe_file {
    local *FH;
    open FH, ">$_[0]";
    print FH " ";
    close FH;
}

for ($ht_access, $hooks_file) {
    wipe_file($_);
}

local *FH;
if(Apache::perl_hook("Authen")) {
    open FH, ">$ht_access";
    print FH <<EOF;
AuthType Basic
AuthName mod_perl_tests

<Limit GET>
require valid-user
</Limit>

EOF
    close FH;
}


my($hook, $package, $retval);

#hmm, Cleanup doesn't seem to work in .htaccess with register_cleanup()
for (qw(Access Authen Authz Fixup
	HeaderParser Init Log Type Trans)) {
    next unless Apache::perl_hook($_);
    $tests++; 
    $retval = -1; #we want to decline Trans, but ok for Authen, etc.
    $hook = "Perl${_}Handler";
    $package = $hook; #"Apache::$hook";
    unless ($_ eq "Trans") { #must be in server configs
	$retval = 0;
	open FH, ">>$ht_access" or die "can't open $ht_access";
	print FH "$hook $package\n";
	close FH;
    }

    undef &{"$package\:\:handler"}; #avoid warnings
    eval <<"PACKAGE";
package $package;

sub $package\:\:handler {
    my(\$r) = \@_;
    return -1 unless \$r->is_main;
    open FH, ">>$hooks_file" or die "can't open $hooks_file";
    print FH "$hook ok\n";
    close FH;
    return $retval;
}	

PACKAGE

    $r->print($@) if $@;
}

#if(Apache::perl_hook("Log") and Apache::perl_hook("Fixup")) {
#    undef &PerlLogHandler::handler;
#    @PerlLogHandler::ISA = qw(PerlFixupHandler);
#    $r->warn("PerlLogHandler isa PerlFixupHandler");
#}

if($My::config_is_perl) {
    $tests--;
    #warn "XXX: skipping hook test for <Perl> config of \$PerlTransHandler\n";
}

$r->print($tests);