📄 ch06l03.txt
字号:
Listing 6.3 Debug by trapping error messages.############################################################################## DEBUGCGI.PL #### This is a simple script which sets up a test environment for CGI #### script to be executed and then traps the common errors. The PATH is #### set to the minimal set by most systems, for example. All error messages#### are trapped and made available to the user. #### #### This code is in the public domain for people to do whatever they wish #### to with it. But, maintain this copyright notice and don't say you #### wrote it. This work is distributed in the hope that its useful. But, #### the author is not liable for any any incurred damages, directly or #### indirectly due to the use or inability to use this software. ##############################################################################$tmpdir = "/tmp/"; # The directory under which the error file will be created.require "cgi-parse.pl";%cgi_input = ();&CGIGetInput(*cgi_input);$script = $cgi_input{'DebugCgi-ScriptName'};$method = $cgi_input{'DebugCgi-Method'};$cmdargs = $cgi_input {'DebugCgi-CmdArgs'};delete ($cgi_input {'DebugCgi-ScriptName'});delete ($cgi_input {'DebugCgi-Method'});delete ($cgi_input {'DebugCgi-CmdArgs'});$inp = "";foreach $elem (keys %cgi_input) { $cgi_input{$elem} = $cgi_input{$elem}; $cgi_input{$elem} =~ s# #+#g; $cgi_input{$elem} =~ s#([^+A-Za-z0-9])#sprintf("%%%02x",ord($1))#ge; $cgi_input{$elem} =~ s#%3d#=#g; $inp .= "$elem=$cgi_input{$elem}&";}# Encode the input in the form used by HTTP.# Turn off the include path. The script must use its own @INC and environment.if (! -e $script) {&PrintErrHeader; print "<B>Script <EM>$script</EM> does not exist</B><BR>"; &PrintErrTrailer; exit (2);}if (! -r $script && ! -x $script) { &PrintErrHeader; print "<B>Script <EM>$script</EM> is not readable/executable by server</B><BR>"; &PrintErrTrailer; exit (2);}#Set the request method.$error_file = $tmpdir.$^T;$ENV{'REQUEST_METHOD'} = $method;if ($method eq "GET") { $ENV{'QUERY_STRING'} = $inp; open (OUTPUT, "$script $cmdargs 2\>/tmp/errors |") || &cry ("unable to pipe script $! \n");}elsif ($method eq "POST") { $ENV{'CONTENT_LENGTH'} = length($inp); open (OUTPUT, "echo \"$inp\" | $script $cmdargs 2>$error_file |") || &cry ("unable to pipe script $! \n");}else { &PrintHeader; print "Unknown method: $method\n"; exit (3);}$_ = <OUTPUT>;if (!/^Content-type: / && !/^Location: /) { if (-s $error_file) { open (ERRF, "< $error_file") || &cry ("testcgi.cgi - Unable to open error file $!\n"); &PrintHeader; print "<HTML><BODY>\n"; @errors = <ERRF>; &PrintErrHeader; print "<B>Script <EM>$script</EM> has an execution error !!!</B><BR><BR>"; print "@errors \n"; &PrintErrTrailer; unlink ($error_file); exit (4); }&PrintErrHeader; print "The script <EM>$script</EM> has an error :<BR><BR>"; print "It does not output the Content-type/Location header.<BR>"; print "Here's what it printed as the first line.\n"; print "<PRE>\n"; print; print "</PRE>\n"; &PrintErrTrailer; exit (3);}$format = m#^Content-type:[ \t]*text/html#;$_ = <OUTPUT>;if (!/^$/) { &PrintErrHeader; print "The script <EM>$script</EM> has an error :<BR><BR>"; print "The second line it outputs must be a blank, instead I got <PRE>\n"; print; print "</PRE>"; &PrintErrTrailer; exit (3);}&PrintHeader;print "<HTML><BODY><H3>Script <I>$script</I> seems OK !</H3> \n";print "<P ALIGN=Justify> Here is its output:<BR>\n";print "<PRE>\n" if (!$format) ;print $ENV{'PATH_INFO'},"\n";while (<OUTPUT>) { print;}print "</PRE>" if (!$format);print "</BODY></HTML>";exit (0);sub cry { local ($message) = @_; &PrintHeader; print "<HTML><BODY><H2>Debugcgi Error !!</H2>"; print "DebugCGI encountered an error during execution. The error is: ", $message; print "\n<BODY><HTML>"; exit;}sub PrintErrHeader { &PrintHeader; print "<HTML><BODY><H3>Script Error !!</H3>";}sub PrintErrTrailer { print "</BODY></HTML>\n";}⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -