package Debug2;

print "Content-type: text/plain\n\nIn Debug2\n";

warn "In Debug2\n";

use Apache;
Apache->push_handlers("PerlHandler", \&PH);

1;

sub PH 
{ 
    my $r = shift;
    warn "In PH2!\n";  
    my $package = &get_package($r); 
#    my $package = "Apache::ROOT::perl::dist::CGI_2dDebug_2d0_2e06::test::test_2epl";
    
    my $filename = $r->filename;

my $eval2 = join(
		 '',
		 "my \$save = \\&$package\::handler;",
		 'package ',
		 $package.";\n",
		 'sub copy {',
		 "\n#line 1 $filename\n",
		 '&$save; ',
		 '&Debug2::footer;',
		 "\n}",
		 );
eval $eval2;

my $eval3 = join(
		 '',
		 'package ',
		 $package.";\n",
		 'sub handler {',
		 "\n#line 1 $filename\n",
		 "&$package\::copy;",
		 "\n}",
		 );

eval $eval3;

    warn "\n-------------------\n";
    warn $eval3;
    warn "\n\n";


}

sub compile {
    my $eval = shift;
    Apache->untaint($eval);
    eval $eval;
}

sub Debug2::footer
{
    print "<hr><h1>Am I cool or what!?</h1>\n";
}

sub get_package
{
    my $r = shift;
    my $uri = $r->uri;
    $uri = "/__INDEX__" if $uri eq "/";
    # turn into a package name
    my $script_name = $r->path_info ?
	substr($uri, 0, length($uri)-length($r->path_info)) :
	    $uri;
    
    if($Apache::Registry::NameWithVirtualHost) {
	my $name = $r->get_server_name;
	$script_name = join "", $name, $script_name if $name;
    }
    
    # Escape everything into valid perl identifiers
    $script_name =~ s/([^A-Za-z0-9\/])/sprintf("_%2x",unpack("C",$1))/eg;
    
    # second pass cares for slashes and words starting with a digit
    $script_name =~ s{
	(/+)       # directory
	(\d?)      # package's first character
	}[
          "::" . ($2 ? sprintf("_%2x",unpack("C",$2)) : "")
	  ]egx;
    
    my $package = "Apache::ROOT$script_name";

    return $package;
}