# subroutine name: cgidie_and_log # # 1. Displays error message # 2. Logs error to "logs/error.log". # 3. Exits from script immediately # Calls stack is logged to "logs/error.log", but NOT displayed to visitors. # # Global variables used: # $last_die_calls_stack - filled by &catch_die_call_stack() subroutine # $admin_email - e-mail address of admin # # No operations should be performed after calling this subroutine sub cgidie { my($my_mesg, $sys_mesg) = @_; print qq~Content-type: text/html $my_mesg SCRIPT ERROR!!!
There was an error in processing your request.
Following is the error message:
Please contact the administrator of this site.

Thank you.

We sincerely apologize for the inconvenience. ~; # Log fatal error LOG("errors", "Script fatal error. Script message: $my_mesg; System message: $sys_mesg; Calls stack: $last_die_calls_stack"); exit; } $SIG{__DIE__} = \&DB::catch_die_call_stack; package DB; # If subroutine is in package DB, we can also trace passed parameters sub catch_die_call_stack { my ($error) = @_; # Record calls stack of last die my $sub_way; my ($p,$f,$l,$s,$h,$a,@a,$w); for (my $i = 1; ($p,$f,$l,$s,$h,$w) = caller($i); $i++) { @a = (); foreach my $arg (@DB::args) { $_ = "$arg"; s/'/\\'/g; s/([^\0]*)/'$1'/ unless /^(?: -?[\d.]+ | \*[\w:]* )$/x; s/([\200-\377])/sprintf("M-%c",ord($1)&0177)/eg; s/([\0-\37\177])/sprintf("^%c",ord($1)^64)/eg; push(@a, $_); } $w = $w ? '@ = ' : '$ = '; $a = $h ? '(' . join(', ', @a) . ')' : ''; $sub_way .= "$w$s$a from file $f line $l\n"; } $main::last_die_calls_stack = $sub_way; # confirm die die $error; }; package main;