From 445f1e07d9f29cccbe16b03b4775950afe2fd140 Mon Sep 17 00:00:00 2001
From: Martin Mares <mj@ucw.cz>
Date: Fri, 20 Jul 2007 16:36:48 +0200
Subject: [PATCH] CGI: Added error handling and strictness.

---
 lib/perl/CGI.pm | 60 ++++++++++++++++++++++++++++++++++++++++---------
 1 file changed, 49 insertions(+), 11 deletions(-)

diff --git a/lib/perl/CGI.pm b/lib/perl/CGI.pm
index daf10eb6..9d1bc4fb 100644
--- a/lib/perl/CGI.pm
+++ b/lib/perl/CGI.pm
@@ -6,22 +6,60 @@
 #	This software may be freely distributed and used according to the terms
 #	of the GNU Lesser General Public License.
 
+# FIXME:
+# - respond with proper HTTP error codes
+# - if we get invalid parameters, generate HTTP error or redirect
+
 package UCW::CGI;
 
-use strict;
-use warnings;
+# 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
+#					(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 {
-	# The somewhat hairy Perl export mechanism
-	use Exporter();
-	our ($VERSION, @ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS);
-	$VERSION = 1.0;
-	@ISA = qw(Exporter);
-	@EXPORT = qw(&html_escape &url_escape &url_param_escape &self_ref &self_form);
-	@EXPORT_OK = qw();
-	%EXPORT_TAGS = ();
+	$SIG{__DIE__} = sub { report_bug($_[0]); };
+	$SIG{__WARN__} = sub { report_bug("WARNING: " . $_[0]); };
+	$exit_code = 0;
 }
 
+END {
+	$? = $exit_code;
+}
+
+use strict;
+use warnings;
+
+require Exporter;
+our $VERSION = 1.0;
+our @ISA = qw(Exporter);
+our @EXPORT = qw(&html_escape &url_escape &url_param_escape &self_ref &self_form &http_get);
+our @EXPORT_OK = qw();
+
 ### Escaping ###
 
 sub url_escape($) {
@@ -81,7 +119,7 @@ sub http_get($) {
 
 ### Parsing of Arguments ###
 
-our $arg_table;
+my $arg_table;
 
 sub parse_arg_string($) {
 	my ($s) = @_;
-- 
2.39.2