From 39b28bffc195348b93294b5fa0a8b9e87ea7317a Mon Sep 17 00:00:00 2001 From: Martin Mares Date: Wed, 26 Dec 2012 20:13:13 +0100 Subject: [PATCH] UCW::CGI error handling split off to separate module UCW::CGI::ErrorHandler I was really fed up with replaced error handling in indirectly related pieces of code (like modules, which use UCW::CGI, because they might be called in a context of a CGI script under some circumstances). Let the people who want custom error handling ask for it directly. --- ucw/perl/UCW/CGI.pm | 43 ++------------------------ ucw/perl/UCW/CGI/ErrorHandler.pm | 53 ++++++++++++++++++++++++++++++++ ucw/perl/UCW/CGI/Makefile | 15 +++++++++ ucw/perl/UCW/Makefile | 1 + 4 files changed, 72 insertions(+), 40 deletions(-) create mode 100644 ucw/perl/UCW/CGI/ErrorHandler.pm create mode 100644 ucw/perl/UCW/CGI/Makefile diff --git a/ucw/perl/UCW/CGI.pm b/ucw/perl/UCW/CGI.pm index b90b8d29..7cb34639 100644 --- a/ucw/perl/UCW/CGI.pm +++ b/ucw/perl/UCW/CGI.pm @@ -8,45 +8,6 @@ package UCW::CGI; -# First of all, set up error handling, so that even errors during parsing -# will be reported properly. - -# Variables to be set by the calling module: -# $UCW::CGI::error_mail mail address of the script admin (optional) -# (this one has to be set in the BEGIN block!) -# $UCW::CGI::error_hook function to be called for reporting errors - -my $error_reported; -my $exit_code; -my $debug = 0; - -sub report_bug($) -{ - if (!defined $error_reported) { - $error_reported = 1; - print STDERR $_[0]; - if (defined($UCW::CGI::error_hook)) { - &$UCW::CGI::error_hook($_[0]); - } else { - print "Content-Type: text/plain\n\n"; - print "Internal bug:\n"; - print $_[0], "\n"; - print "Please notify $UCW::CGI::error_mail\n" if defined $UCW::CGI::error_mail; - } - } - die; -} - -BEGIN { - $SIG{__DIE__} = sub { report_bug($_[0]); }; - $SIG{__WARN__} = sub { report_bug("WARNING: " . $_[0]); }; - $exit_code = 0; -} - -END { - $? = $exit_code; -} - use strict; use warnings; @@ -56,6 +17,8 @@ our @ISA = qw(Exporter); our @EXPORT = qw(&html_escape &url_escape &url_deescape &url_param_escape &url_param_deescape &self_ref &self_form &http_get); our @EXPORT_OK = qw(); +# Configuration settings +our $debug = 0; our $utf8_mode = 0; sub http_error($;@) { @@ -168,7 +131,7 @@ sub parse_multipart_form_data(); sub init_args() { if (!defined $ENV{"GATEWAY_INTERFACE"}) { print STDERR "Must be called as a CGI script.\n"; - $exit_code = 1; + $UCW::CGI::ErrorHandler::exit_code = 1; exit; } diff --git a/ucw/perl/UCW/CGI/ErrorHandler.pm b/ucw/perl/UCW/CGI/ErrorHandler.pm new file mode 100644 index 00000000..16ccfa24 --- /dev/null +++ b/ucw/perl/UCW/CGI/ErrorHandler.pm @@ -0,0 +1,53 @@ +# Poor Man's CGI Module for Perl -- Error Handling +# +# (c) 2002--2012 Martin Mares +# +# This software may be freely distributed and used according to the terms +# of the GNU Lesser General Public License. + +package UCW::CGI::ErrorHandler; + +# E-mail address of the script admin (optional, preferably set in a BEGIN block) +our $error_mail; + +# A function called for reporting of errors +our $error_hook; + +# Set to true if you want to show detailed error messages to the user +our $print_errors = 0; + +my $error_reported; +our $exit_code; + +sub report_bug($) +{ + if (!defined $error_reported) { + $error_reported = 1; + print STDERR $_[0]; + if (defined($error_hook)) { + &$error_hook($_[0]); + } else { + print "Status: 500\n"; + print "Content-Type: text/plain\n\n"; + if ($print_errors) { + print "Internal bug: ", $_[0], "\n"; + } else { + print "Internal bug.\n"; + } + print "Please notify $error_mail\n" if defined $error_mail; + } + } + die; +} + +BEGIN { + $SIG{__DIE__} = sub { report_bug($_[0]); }; + $SIG{__WARN__} = sub { report_bug("WARNING: " . $_[0]); }; + $exit_code = 0; +} + +END { + $? = $exit_code; +} + +42; diff --git a/ucw/perl/UCW/CGI/Makefile b/ucw/perl/UCW/CGI/Makefile new file mode 100644 index 00000000..f57b838c --- /dev/null +++ b/ucw/perl/UCW/CGI/Makefile @@ -0,0 +1,15 @@ +# More CGI support + +DIRS+=ucw/perl/UCW/CGI +EXTRA_RUNDIRS+=lib/perl5/UCW/CGI +UCW_CGI_PERL_MODULES+=ErrorHandler.pm +CGI_MODULES=$(addprefix $(o)/ucw/perl/UCW/CGI/,$(UCW_CGI_PERL_MODULES)) +PROGS+=$(CGI_MODULES) + +$(CGI_MODULES) : PERL_MODULE_DIR=UCW/CGI + +INSTALL_TARGETS+=install-perl-ucw-cgi +install-perl-ucw-cgi: + install -d -m 755 $(DESTDIR)$(INSTALL_PERL_DIR)/UCW/CGI + install -m 644 $(addprefix $(s)/ucw/perl/UCW/CGI/,$(UCW_CGI_PERL_MODULES)) $(DESTDIR)$(INSTALL_PERL_DIR)/UCW/CGI +.PHONY: install-perl-ucw-cgi diff --git a/ucw/perl/UCW/Makefile b/ucw/perl/UCW/Makefile index 1ae12212..ddbcfecf 100644 --- a/ucw/perl/UCW/Makefile +++ b/ucw/perl/UCW/Makefile @@ -5,6 +5,7 @@ EXTRA_RUNDIRS+=lib/perl5/UCW UCW_PERL_MODULES=$(addsuffix .pm,Config Log CGI Configure) PROGS+=$(addprefix $(o)/ucw/perl/UCW/,$(UCW_PERL_MODULES)) +include $(s)/ucw/perl/UCW/CGI/Makefile include $(s)/ucw/perl/UCW/Configure/Makefile INSTALL_TARGETS+=install-perl-ucw -- 2.39.2