r23879 - in /branches/upstream/libcgi-pm-perl/current: CGI.pm CGI/Fast.pm Changes META.yml Makefile.PL t/request.t
ansgar-guest at users.alioth.debian.org
ansgar-guest at users.alioth.debian.org
Thu Aug 7 11:10:34 UTC 2008
Author: ansgar-guest
Date: Thu Aug 7 11:10:32 2008
New Revision: 23879
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=23879
Log:
[svn-upgrade] Integrating new upstream version, libcgi-pm-perl (3.40)
Modified:
branches/upstream/libcgi-pm-perl/current/CGI.pm
branches/upstream/libcgi-pm-perl/current/CGI/Fast.pm
branches/upstream/libcgi-pm-perl/current/Changes
branches/upstream/libcgi-pm-perl/current/META.yml
branches/upstream/libcgi-pm-perl/current/Makefile.PL
branches/upstream/libcgi-pm-perl/current/t/request.t
Modified: branches/upstream/libcgi-pm-perl/current/CGI.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcgi-pm-perl/current/CGI.pm?rev=23879&op=diff
==============================================================================
--- branches/upstream/libcgi-pm-perl/current/CGI.pm (original)
+++ branches/upstream/libcgi-pm-perl/current/CGI.pm Thu Aug 7 11:10:32 2008
@@ -18,8 +18,8 @@
# The most recent version and complete docs are available at:
# http://stein.cshl.org/WWW/software/CGI/
-$CGI::revision = '$Id: CGI.pm,v 1.254 2008/06/25 14:52:19 lstein Exp $';
-$CGI::VERSION='3.38';
+$CGI::revision = '$Id: CGI.pm,v 1.257 2008/08/06 14:01:06 lstein Exp $';
+$CGI::VERSION='3.40';
# HARD-CODED LOCATION FOR FILE UPLOAD TEMPORARY FILES.
# UNCOMMENT THIS ONLY IF YOU KNOW WHAT YOU'RE DOING.
@@ -1176,7 +1176,7 @@
'EXISTS' => <<'END_OF_FUNC',
sub EXISTS {
- exists $_[0]->{$_[1]};
+ exists $_[0]->{param}{$_[1]};
}
END_OF_FUNC
@@ -2849,30 +2849,58 @@
}
END_OF_FUNC
-# WE USE THIS TO COMPENSATE FOR A BUG IN APACHE 2 PRESENT AT LEAST UP THROUGH 2.0.54
+# This function returns a potentially modified version of SCRIPT_NAME
+# and PATH_INFO. Some HTTP servers do sanitise the paths in those
+# variables. It is the case of at least Apache 2. If for instance the
+# user requests: /path/./to/script.cgi/x//y/z/../x?y, Apache will set:
+# REQUEST_URI=/path/./to/script.cgi/x//y/z/../x?y
+# SCRIPT_NAME=/path/to/env.cgi
+# PATH_INFO=/x/y/x
+#
+# This is all fine except that some bogus CGI scripts expect
+# PATH_INFO=/http://foo when the user requests
+# http://xxx/script.cgi/http://foo
+#
+# Old versions of this module used to accomodate with those scripts, so
+# this is why we do this here to keep those scripts backward compatible.
+# Basically, we accomodate with those scripts but within limits, that is
+# we only try to preserve the number of / that were provided by the user
+# if $REQUEST_URI and "$SCRIPT_NAME$PATH_INFO" only differ by the number
+# of consecutive /.
+#
+# So for instance, in: http://foo/x//y/script.cgi/a//b, we'll return a
+# script_name of /x//y/script.cgi and a path_info of /a//b, but in:
+# http://foo/./x//z/script.cgi/a/../b//c, we'll return the versions
+# possibly sanitised by the HTTP server, so in the case of Apache 2:
+# script_name == /foo/x/z/script.cgi and path_info == /b/c.
+#
+# Future versions of this module may no longer do that, so one should
+# avoid relying on the browser, proxy, server, and CGI.pm preserving the
+# number of consecutive slashes as no guarantee can be made there.
'_name_and_path_from_env' => <<'END_OF_FUNC',
sub _name_and_path_from_env {
- my $self = shift;
- my $raw_script_name = $ENV{SCRIPT_NAME} || '';
- my $raw_path_info = $ENV{PATH_INFO} || '';
- my $uri = unescape($self->request_uri) || '';
-
- my $protected = quotemeta($raw_path_info);
- $raw_script_name =~ s/$protected$//;
-
- my @uri_double_slashes = $uri =~ m^(/{2,}?)^g;
- my @path_double_slashes = "$raw_script_name $raw_path_info" =~ m^(/{2,}?)^g;
-
- my $apache_bug = @uri_double_slashes != @path_double_slashes;
- return ($raw_script_name,$raw_path_info) unless $apache_bug;
-
- my $path_info_search = quotemeta($raw_path_info);
- $path_info_search =~ s!/!/+!g;
- if ($uri =~ m/^(.+)($path_info_search)/) {
- return ($1,$2);
- } else {
- return ($raw_script_name,$raw_path_info);
- }
+ my $self = shift;
+ my $script_name = $ENV{SCRIPT_NAME} || '';
+ my $path_info = $ENV{PATH_INFO} || '';
+ my $uri = $self->request_uri || '';
+
+ $uri =~ s/\?.*//s;
+ $uri = unescape($uri);
+
+ if ($uri ne "$script_name$path_info") {
+ my $script_name_pattern = quotemeta($script_name);
+ my $path_info_pattern = quotemeta($path_info);
+ $script_name_pattern =~ s{(?:\\/)+}{/+}g;
+ $path_info_pattern =~ s{(?:\\/)+}{/+}g;
+
+ if ($uri =~ /^($script_name_pattern)($path_info_pattern)$/s) {
+ # REQUEST_URI and SCRIPT_NAME . PATH_INFO only differ by the
+ # numer of consecutive slashes, so we can extract the info from
+ # REQUEST_URI:
+ ($script_name, $path_info) = ($1, $2);
+ }
+ }
+ return ($script_name,$path_info);
}
END_OF_FUNC
Modified: branches/upstream/libcgi-pm-perl/current/CGI/Fast.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcgi-pm-perl/current/CGI/Fast.pm?rev=23879&op=diff
==============================================================================
--- branches/upstream/libcgi-pm-perl/current/CGI/Fast.pm (original)
+++ branches/upstream/libcgi-pm-perl/current/CGI/Fast.pm Thu Aug 7 11:10:32 2008
@@ -82,18 +82,17 @@
=head1 DESCRIPTION
-CGI::Fast is a subclass of the CGI object created by
-CGI.pm. It is specialized to work well with the Open Market
-FastCGI standard, which greatly speeds up CGI scripts by
-turning them into persistently running server processes. Scripts
-that perform time-consuming initialization processes, such as
-loading large modules or opening persistent database connections,
-will see large performance improvements.
+CGI::Fast is a subclass of the CGI object created by CGI.pm. It is
+specialized to work well FCGI module, which greatly speeds up CGI
+scripts by turning them into persistently running server processes.
+Scripts that perform time-consuming initialization processes, such as
+loading large modules or opening persistent database connections, will
+see large performance improvements.
=head1 OTHER PIECES OF THE PUZZLE
-In order to use CGI::Fast you'll need a FastCGI-enabled Web
-server. See http://www.fastcgi.com/ for details.
+In order to use CGI::Fast you'll need the FCGI module. See
+http://www.cpan.org/ for details.
=head1 WRITING FASTCGI PERL SCRIPTS
@@ -106,7 +105,7 @@
A typical FastCGI script will look like this:
- #!/usr/local/bin/perl # must be a FastCGI version of perl!
+ #!/usr/bin/perl
use CGI::Fast;
&do_some_initialization();
while ($q = new CGI::Fast) {
Modified: branches/upstream/libcgi-pm-perl/current/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcgi-pm-perl/current/Changes?rev=23879&op=diff
==============================================================================
--- branches/upstream/libcgi-pm-perl/current/Changes (original)
+++ branches/upstream/libcgi-pm-perl/current/Changes Thu Aug 7 11:10:32 2008
@@ -1,3 +1,12 @@
+ Version 3.40
+ 1. Fixed CGI::Fast docs to eliminate references to a "special"
+ version of Perl.
+ 2. Makefile.PL now depends on FCGI so that CGI::Fast installs properly.
+ 3. Fix script_name() call from Stephane Chazelas.
+
+ Version 3.39
+ 1. Fixed regression in "exists" function when using tied interface to CGI via $q->Vars.
+
Version 3.38
1. Fix annoying warning in http://rt.cpan.org/Ticket/Display.html?id=34551
2. Added nobr() function http://rt.cpan.org/Ticket/Display.html?id=35377
Modified: branches/upstream/libcgi-pm-perl/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcgi-pm-perl/current/META.yml?rev=23879&op=diff
==============================================================================
--- branches/upstream/libcgi-pm-perl/current/META.yml (original)
+++ branches/upstream/libcgi-pm-perl/current/META.yml Thu Aug 7 11:10:32 2008
@@ -1,12 +1,13 @@
--- #YAML:1.0
name: CGI.pm
-version: 3.38
+version: 3.40
abstract: ~
license: ~
author: ~
generated_by: ExtUtils::MakeMaker version 6.44
distribution_type: module
requires:
+ FCGI: 0.67
File::Spec: 0.82
meta-spec:
url: http://module-build.sourceforge.net/META-spec-v1.3.html
Modified: branches/upstream/libcgi-pm-perl/current/Makefile.PL
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcgi-pm-perl/current/Makefile.PL?rev=23879&op=diff
==============================================================================
--- branches/upstream/libcgi-pm-perl/current/Makefile.PL (original)
+++ branches/upstream/libcgi-pm-perl/current/Makefile.PL Thu Aug 7 11:10:32 2008
@@ -12,6 +12,7 @@
'VERSION_FROM' => 'CGI.pm',
'PREREQ_PM' => {
'File::Spec' => .82,
+ 'FCGI' => 0.67,
},
'linkext' => { LINKTYPE=>'' }, # no link needed
'dist' => {'COMPRESS'=>'gzip -9f', 'SUFFIX' => 'gz',
Modified: branches/upstream/libcgi-pm-perl/current/t/request.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcgi-pm-perl/current/t/request.t?rev=23879&op=diff
==============================================================================
--- branches/upstream/libcgi-pm-perl/current/t/request.t (original)
+++ branches/upstream/libcgi-pm-perl/current/t/request.t Thu Aug 7 11:10:32 2008
@@ -4,7 +4,7 @@
######################### We start with some black magic to print on failure.
use lib '.','../blib/lib','../blib/arch';
-BEGIN {$| = 1; print "1..33\n"; }
+BEGIN {$| = 1; print "1..34\n"; }
END {print "not ok 1\n" unless $loaded;}
use CGI ();
use Config;
@@ -74,6 +74,7 @@
test(29,$p->{bar} eq 'froz',"tied interface fetch");
$p->{bar} = join("\0",qw(foo bar baz));
test(30,join(' ',$q->param('bar')) eq 'foo bar baz','tied interface store');
+test(31,exists $p->{bar});
# test posting
$q->_reset_globals;
@@ -88,11 +89,11 @@
exit 0;
}
# at this point, we're in a new (child) process
- test(31,$q=new CGI,"CGI::new() from POST");
- test(32,$q->param('weather') eq 'nice',"CGI::param() from POST");
- test(33,$q->url_param('big_balls') eq 'basketball',"CGI::url_param()");
+ test(32,$q=new CGI,"CGI::new() from POST");
+ test(33,$q->param('weather') eq 'nice',"CGI::param() from POST");
+ test(34,$q->url_param('big_balls') eq 'basketball',"CGI::url_param()");
} else {
- print "ok 31 # Skip\n";
print "ok 32 # Skip\n";
print "ok 33 # Skip\n";
+ print "ok 34 # Skip\n";
}
More information about the Pkg-perl-cvs-commits
mailing list