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.

diff --git a/ucw/perl/UCW/CGI.pm b/ucw/perl/UCW/CGI.pm
index b90b8d2951b2380b657176e9955e7afe3f0428d4..7cb346391d6a1f89dd6ee78118c197df6624d3d0 100644 (file)
--- 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 (file)
index 0000000..16ccfa2
--- /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 <mj@ucw.cz>
+#
+#      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 (file)
index 0000000..f57b838
--- /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 1ae12212abee583e31070466f01fd06b32576240..ddbcfecfa4f98252dbc3f2fd10f171ac7c4c02d5 100644 (file)
--- 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