Build: Make sure that we link against the locally compiled dynamic libraries.

[libucw.git] / ucw / perl / UCW / CGI.pm

diff --git a/ucw/perl/UCW/CGI.pm b/ucw/perl/UCW/CGI.pm
index d2468b8fe48b121dd35fca862f5ebbc22d384a4d..f81bd3ea300da22776457a5cf0b52ed34f17791b 100644 (file)
--- a/ucw/perl/UCW/CGI.pm
+++ b/ucw/perl/UCW/CGI.pm
@@ -8,45 +8,6 @@
 
 package UCW::CGI;
 
 
 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;
 
 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();
 
 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($;@) {
 our $utf8_mode = 0;
 
 sub http_error($;@) {


@@ -68,6 +31,7 @@ sub http_error($;@) {
 
 sub url_escape($) {
        my $x = shift @_;
 
 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;
        utf8::encode($x) if $utf8_mode;
        $x =~ s/([^-\$_.!*'(),0-9A-Za-z\x80-\xff])/"%".unpack('H2',$1)/ge;
        utf8::decode($x) if $utf8_mode;


@@ -76,6 +40,7 @@ sub url_escape($) {
 
 sub url_deescape($) {
        my $x = shift @_;
 
 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;
        utf8::encode($x) if $utf8_mode;
        $x =~ s/%(..)/pack("H2",$1)/ge;
        utf8::decode($x) if $utf8_mode;


@@ -84,6 +49,7 @@ sub url_deescape($) {
 
 sub url_param_escape($) {
        my $x = shift @_;
 
 sub url_param_escape($) {
        my $x = shift @_;

+       defined $x or return;

        $x = url_escape($x);
        $x =~ s/%20/+/g;
        return $x;
        $x = url_escape($x);
        $x =~ s/%20/+/g;
        return $x;


@@ -91,12 +57,14 @@ sub url_param_escape($) {
 
 sub url_param_deescape($) {
        my $x = shift @_;
 
 sub url_param_deescape($) {
        my $x = shift @_;

+       defined $x or return;

        $x =~ s/\+/ /g;
        return url_deescape($x);
 }
 
 sub html_escape($) {
        my $x = shift @_;
        $x =~ s/\+/ /g;
        return url_deescape($x);
 }
 
 sub html_escape($) {
        my $x = shift @_;

+       defined $x or return;

        $x =~ s/&/&/g;
        $x =~ s/</&lt;/g;
        $x =~ s/>/&gt;/g;
        $x =~ s/&/&amp;/g;
        $x =~ s/</&lt;/g;
        $x =~ s/>/&gt;/g;


@@ -168,7 +136,7 @@ sub parse_multipart_form_data();
 sub init_args() {
        if (!defined $ENV{"GATEWAY_INTERFACE"}) {
                print STDERR "Must be called as a CGI script.\n";
 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;
        }
 
                exit;
        }
 


@@ -191,7 +159,7 @@ sub init_args() {
                        exit;
                }
        } else {
                        exit;
                }
        } else {

-               http_error "405 Method Not Allowed", "Allow: GET, HEAD, PUT";
+               http_error "405 Method Not Allowed", "Allow: GET, HEAD, POST";

        }
 }
 
        }
 }
 


@@ -204,7 +172,7 @@ sub parse_args($) {                 # CAVEAT: attached files must be defined in the main arg t
 
        for my $a (values %$args) {
                my $r = ref($a->{'var'});
 
        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') {
                if ($r eq 'SCALAR') {
                        ${$a->{'var'}} = $a->{'default'};
                } elsif ($r eq 'ARRAY') {