CGI: Added error handling and strictness.

diff --git a/lib/perl/CGI.pm b/lib/perl/CGI.pm
index daf10eb6395b6f30f72774806b7cfff6ebd6d7bb..9d1bc4fbba6d50a5f419cd852a979aa2a1bd3e1f 100644 (file)
--- 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) = @_;