CGI/ErrorHandler.pm

   1 #       Poor Man's CGI Module for Perl -- Error Handling
   2 #
   3 #       (c) 2002--2012 Martin Mares <mj@ucw.cz>
   4 #
   5 #       This software may be freely distributed and used according to the terms
   6 #       of the GNU Lesser General Public License.
   7
   8 package UCW::CGI::ErrorHandler;
   9
  10 # E-mail address of the script admin (optional, preferably set in a BEGIN block)
  11 our $error_mail;
  12
  13 # A function called for reporting of errors
  14 our $error_hook;
  15
  16 # Set to true if you want to show detailed error messages to the user
  17 our $print_errors = 0;
  18
  19 my $error_reported;
  20 our $exit_code;
  21
  22 sub report_bug($)
  23 {
  24         if (!defined $error_reported) {
  25                 $error_reported = 1;
  26                 print STDERR $_[0];
  27                 if (defined($error_hook)) {
  28                         &$error_hook($_[0]);
  29                 } else {
  30                         print "Status: 500\n";
  31                         print "Content-Type: text/plain\n\n";
  32                         if ($print_errors) {
  33                                 print "Internal bug: ", $_[0], "\n";
  34                         } else {
  35                                 print "Internal bug.\n";
  36                         }
  37                         print "Please notify $error_mail\n" if defined $error_mail;
  38                 }
  39         }
  40         die;
  41 }
  42
  43 BEGIN {
  44         $SIG{__DIE__} = sub { report_bug($_[0]); };
  45         $SIG{__WARN__} = sub { report_bug("WARNING: " . $_[0]); };
  46         $exit_code = 0;
  47 }
  48
  49 END {
  50         $? = $exit_code;
  51 }
  52
  53 42;