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;
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($;@) {
sub url_escape($) {
my $x = shift @_;
+ defined $x or return;
utf8::encode($x) if $utf8_mode;
$x =~ s/([^-\$_.!*'(),0-9A-Za-z\x80-\xff])/"%".unpack('H2',$1)/ge;
utf8::decode($x) if $utf8_mode;
sub url_deescape($) {
my $x = shift @_;
+ defined $x or return;
utf8::encode($x) if $utf8_mode;
$x =~ s/%(..)/pack("H2",$1)/ge;
utf8::decode($x) if $utf8_mode;
sub url_param_escape($) {
my $x = shift @_;
- $x = url_escape($x);
+ defined $x or return;
+ utf8::encode($x) if $utf8_mode;
+ $x =~ s/([^-\$_.!*'(),0-9A-Za-z])/"%".unpack('H2',$1)/ge;
$x =~ s/%20/+/g;
+ utf8::decode($x) if $utf8_mode;
return $x;
}
sub url_param_deescape($) {
my $x = shift @_;
+ defined $x or return;
$x =~ s/\+/ /g;
return url_deescape($x);
}
sub html_escape($) {
my $x = shift @_;
+ defined $x or return;
$x =~ s/&/&/g;
$x =~ s/</</g;
$x =~ s/>/>/g;
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;
}
for my $a (values %$args) {
my $r = ref($a->{'var'});
- defined($a->{'default'}) or $a->{'default'}="";
+ $a->{'default'} //= '';
if ($r eq 'SCALAR') {
${$a->{'var'}} = $a->{'default'};
} elsif ($r eq 'ARRAY') {