CGI-Debug
1 match

 view release on metacpan or  search on metacpan

Debug.pm  view on Meta::CPAN 

package CGI::Debug;

use strict;
use vars qw( $VERSION $Module $File_base $Control $Reference 
	     $Content_type $Body_length $Done $DEBUG $Started);
$VERSION = '1.00';

sub BEGIN
{
    $DEBUG = 0;  # <-- DEBUG
    print "Content-Type: text/plain\n\n" if $DEBUG >2; # DEBUG
    $Module = __PACKAGE__;


    sub import_error
      {
	my( $error, $paramsref ) = @_;
	print "Content-Type: text/html\n\n";
	print "<html><head><title>$Module response</title></head><body>";

	print "<p>You got an error!\n";

	if( ref $paramsref and eval{ require "Data/Dumper.pm" } )
	  {
	    print "<pre>\n", Data::Dumper::Dumper( $paramsref ), "</pre>\n\n";
	  }

	print "<p>$error\n";
	print "</body></html>\n";

	# Set error flag, for not go into END
	# This avoid a perl core dump under 5.005_02
	$Done = 1;
      }


    unless( eval{ require 5.004_05 } )
    {
	&import_error("You must at least have perl v 5.004_05 to use $Module");
    }

    if( exists $ENV{'GATEWAY_INTERFACE'} and
	$ENV{'GATEWAY_INTERFACE'} =~ /^CGI-Perl/
	)
    {
	my $modfile = $Module;
	$modfile =~ s/::/\//g;

	my($i,$p,$filename)=0;
	while( ($p,$filename) = caller(++$i) )
	{
	    last unless $filename =~ /\/$modfile\.pm$/;
	}

	warn "$filename: $Module can't be used under mod_perl\n";

	return;
    }

    unless( eval{ require 'CGI.pm' } )
    {
	&import_error("You must have the CGI module to use $Module");
    }
    $CGI::NO_DEBUG = 1; #Do not use STDIN debugging!

    if( eval{ require 'Time/HiRes.pm' } )
    {
	import Time::HiRes 'time';
	$Started = Time::HiRes::time();
    }
    else
    {
	$Started = $^T;
    }


    $Control = {};
    $File_base = "/tmp/$Module";
    $File_base =~ s/::/-/g;

    # Redirect STDERR to a temporary file
    unless( $DEBUG > 1 )
    {
	open(OLDERR, ">&STDERR");  # Save real STDERR
	open (STDERR,">${File_base}-error-$$")
	    or &import_error( "Could not write to file ${File_base}-error-$$: $!\n" );
    }

    $/ ||= "\n"; # Bug in perl 5.005_02 !!!
}


END
{
    return if $Done; # This avoids a perl core dump under 5.005_02
    &cleanup;
}

sub CHECK
{
    return if $Done; # This avoids a perl core dump under 5.005_02
    if( -s "$File_base-error-$$" )
    {
	&cleanup;
	$Done=1;
    }
}


sub import



( run in 1.100 second using v1.01-cache-2.11-cpan-75ffa21a3d4 )