X-Git-Url: http://mj.ucw.cz/gitweb/?a=blobdiff_plain;ds=sidebyside;f=ucw%2Fperl%2FUCW%2FCGI.pm;h=de39d226aad349f54810f9092338f0ac16b3ec27;hb=68de14ab2618ebf4afa9630299cef5eafe13d1be;hp=65c780666b8b314f5bef20cbe2b8c4bf27b7b2af;hpb=fbed568cd23bbbe28418608fc31a355b86df80ae;p=libucw.git

diff --git a/ucw/perl/UCW/CGI.pm b/ucw/perl/UCW/CGI.pm
index 65c78066..de39d226 100644
--- a/ucw/perl/UCW/CGI.pm
+++ b/ucw/perl/UCW/CGI.pm
@@ -1,6 +1,6 @@
 #	Poor Man's CGI Module for Perl
 #
-#	(c) 2002--2010 Martin Mares <mj@ucw.cz>
+#	(c) 2002--2011 Martin Mares <mj@ucw.cz>
 #	Slightly modified by Tomas Valla <tom@ucw.cz>
 #
 #	This software may be freely distributed and used according to the terms
@@ -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($;@) {
@@ -68,6 +31,7 @@ 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;
@@ -76,6 +40,7 @@ sub url_escape($) {
 
 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;
@@ -84,19 +49,24 @@ sub url_deescape($) {
 
 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/&/&amp;/g;
 	$x =~ s/</&lt;/g;
 	$x =~ s/>/&gt;/g;
@@ -168,7 +138,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;
 	}
 
@@ -191,7 +161,7 @@ sub init_args() {
 			exit;
 		}
 	} else {
-		http_error "405 Method Not Allowed", "Allow: GET, HEAD, PUT";
+		http_error "405 Method Not Allowed", "Allow: GET, HEAD, POST";
 	}
 }
 
@@ -204,7 +174,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'});
-		defined($a->{'default'}) or $a->{'default'}="";
+		$a->{'default'} //= '';
 		if ($r eq 'SCALAR') {
 			${$a->{'var'}} = $a->{'default'};
 		} elsif ($r eq 'ARRAY') {
@@ -401,6 +371,10 @@ sub parse_multipart_form_data() {
 				print STDERR "FILE UPLOAD to $fn\n" if $debug;
 				${$a->{"file"}} = $fn;
 				${$a->{"fh"}} = $fh if defined $a->{"fh"};
+				if (defined $a->{"filename"}){
+					my ($filename) = ($cdisp =~ /;filename=([^;]+)/);
+					(${$a->{"filename"}}) = rfc822_deescape($filename) if defined $filename;
+				}
 				my $total_size = 0;
 				while (my $i = refill_mp_data(4096)) {
 					print $fh substr($mp_buffer, $mp_buffer_i, $i);