#!/usr/local/bin/perl -Tw

use Apache ();
use strict;
use vars qw($Scalar @Array %Hash); #for testing perl-status
use vars qw($filename); 

not $filename or die "Apache::Registry scoping is broken!\n";

#make sure this untrip works
$/ eq "\n" or die "\$/ was not reset!\n";
$/ = "";

$Scalar = 1;
@Array  = qw(one two three);
%Hash   = qw(one 1 two 2 three 3);

my $r = Apache->request;
$ENV{PATH} = "/bin";

sub first_one {
    print STDERR "first_one called\n";
    return 0;
}

$r->post_connection(sub {
    my $r = shift;
    $r->warn("post connection handler called for ", $r->uri);
});

if(Apache->can_stack_handlers) {
    Apache->push_handlers("PerlCleanupHandler", \&first_one);

    $r->push_handlers("PerlCleanupHandler", sub {
	print STDERR "__ANON__ called\n";
	return 0;
    });
}

#$r->warn("sequence number: " . $r->seqno);

$r->content_type("text/plain");
$r->send_http_header;

my(@args);
$r->print("KeyForPerlSetVar = ", $r->dir_config('KeyForPerlSetVar'), $/);
if (@args = $r->args) {
    $r->print(
       "ARGS: ",
       join(", ", map { $_ = qq{"$_"} } @args),
       "\n\n");
} else {
    $r->print("No command line arguments passed to script\n\n");
}

my($key,$val);
while (($key,$val) = each %ENV) {
   $r->print("$key=$val\n");
}

if ($ENV{CONTENT_LENGTH}) {
    #$len = $ENV{CONTENT_LENGTH};
    my $content = $r->content;
    eval { system $content }; 
    die "TaintCheck failed, I can `system \$content' ($content:$ENV{CONTENT_LENGTH})" unless $@;
    warn "TRAPPED: `system \$r->content' '$@'\n";

    $r->print("\nContent\n-------\n$content");
}

#even though we exit() here, END block below is still called
test_exit(); # unless $ENV{CONTENT_LENGTH};

sub test_exit {
    exit;
    die "shouldn't get this far!\n";
}

END {
    warn "END block called for `test' ($0)\n";
}
