AtomicSoft.com Add power to your website!
Home Products Services Support Free
EasyData/SQL
easy-to-use web interface for SQL databases with countless features
AtomicDesk
help desk, FAQ, knowledge base, live support chat - all in one product
Custom programming
Installation
Documentation
HelpDesk
Libraries
Join our newsletter for information on software updates and new releases. You may unsubscribe at any time.



Click here to download plain text source code.

# 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

    <html>
    <head>
    <title>$my_mesg</title>
    </head>
    <body bgcolor="#FFFFFF">
    <font face="Arial,Helvetica,sans-serif" size="5"><b>SCRIPT ERROR!!!</b></font>
    <hr>
    <font face="Arial,Helvetica,sans-serif" size="3">
    <b>
    There was an error in processing your request.<br>
    Following is the error message:
    <ul>
    <li>Script Message: $my_mesg
    <li>System Message: $sys_mesg
    </ul>
    <hr>
    Please contact the <a href="mailto:$admin_email">administrator</a> of this site.
    <p>
    Thank you.
    <p>
    We sincerely apologize for the inconvenience.
    </b>
    </font>
    </body>
    </html>
    ~;
    
    # 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;
 
Copyright © 1999-2007 Atomicsoft Ltd. All Rights Reserved.