r52306 - in /trunk/libcgi-pm-perl: ./ debian/ debian/patches/ lib/ lib/CGI/ t/
jawnsy-guest at users.alioth.debian.org
jawnsy-guest at users.alioth.debian.org
Sun Feb 7 22:57:51 UTC 2010
Author: jawnsy-guest
Date: Sun Feb 7 22:57:46 2010
New Revision: 52306
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=52306
Log:
* New upstream release
* Standards-Version 3.8.4 (no changes)
* Rewrite long description
* Add myself to Uploaders and Copyright
* Refresh man-cgi-fast.patch
* Update to new DEP5 copyright format
Added:
trunk/libcgi-pm-perl/t/url.t
- copied unchanged from r52302, branches/upstream/libcgi-pm-perl/current/t/url.t
Modified:
trunk/libcgi-pm-perl/Changes
trunk/libcgi-pm-perl/MANIFEST
trunk/libcgi-pm-perl/META.yml
trunk/libcgi-pm-perl/README
trunk/libcgi-pm-perl/debian/changelog
trunk/libcgi-pm-perl/debian/control
trunk/libcgi-pm-perl/debian/copyright
trunk/libcgi-pm-perl/debian/patches/man-cgi-fast.patch
trunk/libcgi-pm-perl/debian/rules
trunk/libcgi-pm-perl/lib/CGI.pm
trunk/libcgi-pm-perl/lib/CGI/Carp.pm
trunk/libcgi-pm-perl/lib/CGI/Cookie.pm
trunk/libcgi-pm-perl/lib/CGI/Fast.pm
trunk/libcgi-pm-perl/lib/CGI/Util.pm
trunk/libcgi-pm-perl/t/carp.t
trunk/libcgi-pm-perl/t/fast.t
trunk/libcgi-pm-perl/t/function.t
Modified: trunk/libcgi-pm-perl/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libcgi-pm-perl/Changes?rev=52306&op=diff
==============================================================================
--- trunk/libcgi-pm-perl/Changes (original)
+++ trunk/libcgi-pm-perl/Changes Sun Feb 7 22:57:46 2010
@@ -1,3 +1,23 @@
+Version 3.49
+
+ [BUG FIXES]
+ 1. Fix a regression since 3.44 involving a case when the header includes "Content-Length: 0".
+ Thanks to Alex Vandiver (RT#51109)
+ 2. Suppress uninitialized warnings under -w. Thanks to burak. (RT#50301)
+ 3. url() now uses virtual_port() instead of server_port(). Thanks to MKANAT and Yanick Champoux. (RT#51562)
+
+ [SECURITY]
+ 1. embedded newlines are now filtered out of header values in header().
+ Thanks to Mark Stosberg and Yanick Champoux.
+
+ [DOCUMENTATION]
+ 1. README was updated to reflect that CGI.pm was moved under ./lib.
+ Thanks to Alex Vandiver.
+
+ [INTERNALS]
+ 1. More tests were added for autoescape, thanks to Bob Kuo. (RT#25485)
+ 2. Attempt to avoid test failures with t/fast, thanks to Steve Hay. (RT#49599)
+
Version 3.48
[BUG FIXES]
Modified: trunk/libcgi-pm-perl/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libcgi-pm-perl/MANIFEST?rev=52306&op=diff
==============================================================================
--- trunk/libcgi-pm-perl/MANIFEST (original)
+++ trunk/libcgi-pm-perl/MANIFEST Sun Feb 7 22:57:46 2010
@@ -68,6 +68,7 @@
t/upload_post_text.txt
t/uploadInfo.t
t/user_agent.t
+t/url.t
t/utf8.t
t/util-58.t
t/util.t
Modified: trunk/libcgi-pm-perl/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libcgi-pm-perl/META.yml?rev=52306&op=diff
==============================================================================
--- trunk/libcgi-pm-perl/META.yml (original)
+++ trunk/libcgi-pm-perl/META.yml Sun Feb 7 22:57:46 2010
@@ -1,6 +1,6 @@
--- #YAML:1.0
name: CGI.pm
-version: 3.48
+version: 3.49
abstract: ~
license: ~
author: ~
Modified: trunk/libcgi-pm-perl/README
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libcgi-pm-perl/README?rev=52306&op=diff
==============================================================================
--- trunk/libcgi-pm-perl/README (original)
+++ trunk/libcgi-pm-perl/README Sun Feb 7 22:57:46 2010
@@ -15,7 +15,7 @@
If this doesn't work for you, try:
- cp CGI.pm /usr/local/lib/perl5
+ cp lib/CGI.pm /usr/local/lib/perl5
If you have trouble installing CGI.pm because you have insufficient
access privileges to add to the perl library directory, you can still
Modified: trunk/libcgi-pm-perl/debian/changelog
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libcgi-pm-perl/debian/changelog?rev=52306&op=diff
==============================================================================
--- trunk/libcgi-pm-perl/debian/changelog (original)
+++ trunk/libcgi-pm-perl/debian/changelog Sun Feb 7 22:57:46 2010
@@ -1,8 +1,17 @@
-libcgi-pm-perl (3.48-2) UNRELEASED; urgency=low
+libcgi-pm-perl (3.49-1) UNRELEASED; urgency=low
+ [ Jonathan Yu ]
+ * New upstream release
+ * Standards-Version 3.8.4 (no changes)
+ * Rewrite long description
+ * Add myself to Uploaders and Copyright
+ * Refresh man-cgi-fast.patch
+ * Update to new DEP5 copyright format
+
+ [ gregor herrmann ]
* debian/control: s/perl-modules/perl/ in long description.
- -- gregor herrmann <gregoa at debian.org> Fri, 23 Oct 2009 02:24:06 +0200
+ -- Jonathan Yu <jawnsy at cpan.org> Sun, 07 Feb 2010 18:13:57 -0500
libcgi-pm-perl (3.48-1) unstable; urgency=low
Modified: trunk/libcgi-pm-perl/debian/control
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libcgi-pm-perl/debian/control?rev=52306&op=diff
==============================================================================
--- trunk/libcgi-pm-perl/debian/control (original)
+++ trunk/libcgi-pm-perl/debian/control Sun Feb 7 22:57:46 2010
@@ -6,8 +6,8 @@
Maintainer: Debian Perl Group <pkg-perl-maintainers at lists.alioth.debian.org>
Uploaders: AGOSTINI Yves <agostini at univ-metz.fr>,
Damyan Ivanov <dmn at debian.org>, Ansgar Burchardt <ansgar at 43-1.org>,
- gregor herrmann <gregoa at debian.org>
-Standards-Version: 3.8.3
+ gregor herrmann <gregoa at debian.org>, Jonathan Yu <jawnsy at cpan.org>
+Standards-Version: 3.8.4
Homepage: http://search.cpan.org/dist/CGI.pm/
Vcs-Svn: svn://svn.debian.org/pkg-perl/trunk/libcgi-pm-perl/
Vcs-Browser: http://svn.debian.org/viewsvn/pkg-perl/trunk/libcgi-pm-perl/
@@ -15,18 +15,10 @@
Package: libcgi-pm-perl
Architecture: all
Depends: ${perl:Depends}, ${misc:Depends}, libcgi-fast-perl
-Description: Simple Common Gateway Interface Class
- CGI.pm uses perl5 objects to make it easy to create Web fill-out
- forms and parse their contents. This package defines CGI objects,
- entities that contain the values of the current query string and other
- state variables. Using a CGI object's methods, you can examine keywords
- and parameters passed to your script, and create forms whose initial
- values are taken from the current query (thereby preserving state
- information). The module provides shortcut functions that produce
- boilerplate HTML, reducing typing and coding errors. It also provides
- functionality for some of the more advanced features of CGI scripting,
- including support for file uploads, cookies, cascading style sheets,
- server push, and frames.
+Description: module for Common Gateway Interface applications
+ CGI.pm is a Perl module that provides classes useful for creating Web forms
+ and for parsing their contents. It defines CGI objects, entities that contain
+ the values of the current query string and other state variables.
.
- CGI.pm is included in core perl. Use libcgi-pm-perl only for special
- updates like the use of POSTDATA.
+ This module is already included as part of Perl's core distribution, so this
+ package is only beneficial when newer features or bug fixes are required.
Modified: trunk/libcgi-pm-perl/debian/copyright
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libcgi-pm-perl/debian/copyright?rev=52306&op=diff
==============================================================================
--- trunk/libcgi-pm-perl/debian/copyright (original)
+++ trunk/libcgi-pm-perl/debian/copyright Sun Feb 7 22:57:46 2010
@@ -1,26 +1,36 @@
-Format-Specification: http://wiki.debian.org/Proposals/CopyrightFormat?action=recall&rev=226
-Upstream-Name: CGI.pm
-Upstream-Maintainer: Lincoln Stein <lstein at cshl.org>
-Upstream-Source: http://search.cpan.org/dist/CGI.pm/
+Format-Specification: http://svn.debian.org/wsvn/dep/web/deps/dep5.mdwn?op=file&rev=135
+Maintainer: Lincoln D. Stein <lincoln.stein at gmail.com>
+Source: http://search.cpan.org/dist/CGI.pm/
+Name: CGI.pm
Files: *
-Copyright: copyright 1995-2007, Lincoln D. Stein
-License: GPL-1+ | Artistic
- This code is free software; you can redistribute it and/or modify it under the
- same terms as Perl itself.
+Copyright: 1995-2007, Lincoln D. Stein <lincoln.stein at gmail.com>
+License: Artistic or GPL-1+
Files: CGI/Pretty.pm
-Copyright: Copyright 1999, Brian Paulsen. All rights reserved.
-License: GPL-1+ | Artistic
- This code is free software; you can redistribute it and/or modify it under the
- same terms as Perl itself.
+Copyright: 1999, Brian Paulsen <brian at thePaulsens.com>
+License: Artistic or GPL-1+
Files: debian/*
-Copyright: © 2008, AGOSTINI Yves <agostini at univ-metz.fr>
-License: GPL-1+ | Artistic
- The Debian packaging is put under the same terms as the module itself.
+Copyright: 2010, Jonathan Yu <jawnsy at cpan.org>
+ 2008-2009, Ansgar Burchardt <ansgar at 43-1.org>
+ 2008, AGOSTINI Yves <agostini at univ-metz.fr>
+ 2008, Damyan Ivanov <dmn at debian.org>
+ 2008, gregor herrmann <gregoa at debian.org>
+License: Artistic or GPL-1+
-Perl is distributed under your choice of the GNU General Public License or
-the Artistic License. On Debian GNU/Linux systems, the complete text of the
-GNU General Public License can be found in `/usr/share/common-licenses/GPL'
-and the Artistic Licence in `/usr/share/common-licenses/Artistic'.
+License: Artistic
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the Artistic License, which comes with Perl.
+ .
+ On Debian GNU/Linux systems, the complete text of the Artistic License
+ can be found in `/usr/share/common-licenses/Artistic'
+
+License: GPL-1+
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 1, or (at your option)
+ any later version.
+ .
+ On Debian GNU/Linux systems, the complete text of the GNU General
+ Public License can be found in `/usr/share/common-licenses/GPL'
Modified: trunk/libcgi-pm-perl/debian/patches/man-cgi-fast.patch
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libcgi-pm-perl/debian/patches/man-cgi-fast.patch?rev=52306&op=diff
==============================================================================
--- trunk/libcgi-pm-perl/debian/patches/man-cgi-fast.patch (original)
+++ trunk/libcgi-pm-perl/debian/patches/man-cgi-fast.patch Sun Feb 7 22:57:46 2010
@@ -1,8 +1,11 @@
-Change path to FastCGI scripts and perl in documentation
-
---- libcgi-pm-perl.orig/lib/CGI/Fast.pm
-+++ libcgi-pm-perl/lib/CGI/Fast.pm
-@@ -148,7 +148,7 @@
+Description: fix paths to FastCGI scripts
+Author: AGOSTINI Yves <agostini at univ-metz.fr>
+Reviewed-by: Jonathan Yu <jawnsy at cpan.org>
+Origin: vendor
+Forwarded: not-needed
+--- a/lib/CGI/Fast.pm
++++ b/lib/CGI/Fast.pm
+@@ -152,7 +152,7 @@
FastCGI scripts must end in the extension .fcgi. For each script you
install, you must add something like the following to srm.conf:
@@ -11,7 +14,7 @@
This instructs Apache to launch two copies of file_upload.fcgi at
startup time.
-@@ -166,7 +166,7 @@
+@@ -170,7 +170,7 @@
webserver to connect to an external FastCGI server, you would add the following
to your srm.conf:
@@ -20,7 +23,7 @@
Two environment variables affect how the C<CGI::Fast> object is created,
allowing C<CGI::Fast> to be used as an external FastCGI server. (See C<FCGI>
-@@ -187,7 +187,7 @@
+@@ -191,7 +191,7 @@
For example:
Modified: trunk/libcgi-pm-perl/debian/rules
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libcgi-pm-perl/debian/rules?rev=52306&op=diff
==============================================================================
--- trunk/libcgi-pm-perl/debian/rules (original)
+++ trunk/libcgi-pm-perl/debian/rules Sun Feb 7 22:57:46 2010
@@ -1,6 +1,7 @@
#!/usr/bin/make -f
-TMP=$(CURDIR)/debian/libcgi-pm-perl
-EXAMPLES=$(TMP)/usr/share/doc/libcgi-pm-perl/examples
+
+PACKAGE = $(shell dh_listpackages)
+TMP = $(CURDIR)/debian/$(PACKAGE)
%:
dh --with quilt $@
@@ -15,4 +16,4 @@
override_dh_installexamples:
dh_installexamples
- sed -i -e 's;#!/usr/local/bin/perl;#!/usr/bin/perl;' $(EXAMPLES)/*.cgi $(EXAMPLES)/*.pl
+ sed -i '1s|^#!/usr/local/bin/perl|#!/usr/bin/perl|' $(TMP)/usr/share/doc/$(PACKAGE)/examples/*
Modified: trunk/libcgi-pm-perl/lib/CGI.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libcgi-pm-perl/lib/CGI.pm?rev=52306&op=diff
==============================================================================
--- trunk/libcgi-pm-perl/lib/CGI.pm (original)
+++ trunk/libcgi-pm-perl/lib/CGI.pm Sun Feb 7 22:57:46 2010
@@ -19,7 +19,7 @@
# http://stein.cshl.org/WWW/software/CGI/
$CGI::revision = '$Id: CGI.pm,v 1.266 2009/07/30 16:32:34 lstein Exp $';
-$CGI::VERSION='3.48';
+$CGI::VERSION='3.49';
# HARD-CODED LOCATION FOR FILE UPLOAD TEMPORARY FILES.
# UNCOMMENT THIS ONLY IF YOU KNOW WHAT YOU'RE DOING.
@@ -663,7 +663,7 @@
if ( $content_length > 0 ) {
$self->read_from_client(\$query_string,$content_length,0);
}
- else {
+ elsif (not defined $ENV{CONTENT_LENGTH}) {
$self->read_from_stdin(\$query_string);
# should this be PUTDATA in case of PUT ?
my($param) = $meth . 'DATA' ;
@@ -1542,6 +1542,16 @@
'EXPIRES','NPH','CHARSET',
'ATTACHMENT','P3P'], at p);
+ # CR escaping for values, per RFC 822
+ for my $header ($type,$status,$cookie,$target,$expires,$nph,$charset,$attachment,$p3p, at other) {
+ if (defined $header) {
+ $header =~ s/
+ (?<=\n) # For any character proceeded by a newline
+ (?=\S) # ... that is not whitespace
+ / /xg; # ... inject a leading space in the new line
+ }
+ }
+
$nph ||= $NPH;
$type ||= 'text/html' unless defined($type);
@@ -1557,7 +1567,7 @@
# need to fix it up a little.
for (@other) {
# Don't use \s because of perl bug 21951
- next unless my($header,$value) = /([^ \r\n\t=]+)=\"?(.+?)\"?$/;
+ next unless my($header,$value) = /([^ \r\n\t=]+)=\"?(.+?)\"?$/s;
($_ = $header) =~ s/^(\w)(.*)/"\u$1\L$2" . ': '.$self->unescapeHTML($value)/e;
}
@@ -2566,6 +2576,7 @@
my(@values);
@values = $self->_set_values_and_labels($values,\$labels,$name);
$tabindex = $self->element_tab($tabindex);
+ $name = q{} if ! defined $name;
$result = qq/<select name="$name" $tabindex$other>\n/;
for (@values) {
if (/<optgroup/) {
@@ -2626,7 +2637,7 @@
@values = $self->_set_values_and_labels($values,\$labels,$name,$labeled,$novals);
my($other) = @other ? " @other" : '';
- $name=$self->_maybe_escapeHTML($name);
+ $name = $self->_maybe_escapeHTML($name) || q{};
$result = qq/<optgroup label="$name"$other>\n/;
for (@values) {
if (/<optgroup/) {
@@ -2842,21 +2853,22 @@
# $uri =~ s/\Q$path\E$// if defined $path; # remove path
if ($full) {
- my $protocol = $self->protocol();
- $url = "$protocol://";
- my $vh = http('x_forwarded_host') || http('host') || '';
- $vh =~ s/\:\d+$//; # some clients add the port number (incorrectly). Get rid of it.
- if ($vh) {
- $url .= $vh;
- } else {
- $url .= server_name();
- }
- my $port = $self->server_port;
- $url .= ":" . $port
- unless (lc($protocol) eq 'http' && $port == 80)
- || (lc($protocol) eq 'https' && $port == 443);
+ my $protocol = $self->protocol();
+ $url = "$protocol://";
+ my $vh = http('x_forwarded_host') || http('host') || '';
+ $vh =~ s/\:\d+$//; # some clients add the port number (incorrectly). Get rid of it.
+
+ $url .= $vh || server_name();
+
+ my $port = $self->virtual_port;
+
+ # add the port to the url unless it's the protocol's default port
+ $url .= ':' . $port unless (lc($protocol) eq 'http' && $port == 80)
+ or (lc($protocol) eq 'https' && $port == 443);
+
return $url if $base;
- $url .= $uri;
+
+ $url .= $uri;
} elsif ($relative) {
($url) = $uri =~ m!([^/]+)$!;
} elsif ($absolute) {
@@ -4759,7 +4771,7 @@
use CGI;
- open (OUT,">>test.out") || die;
+ open (OUT,'>>','test.out') || die;
$records = 5;
for (0..$records) {
my $q = CGI->new;
@@ -4769,7 +4781,7 @@
close OUT;
# reopen for reading
- open (IN,"test.out") || die;
+ open (IN,'<','test.out') || die;
while (!eof(IN)) {
my $q = CGI->new(\*IN);
print $q->param('counter'),"\n";
@@ -5264,6 +5276,18 @@
In either case, the outgoing header will be formatted as:
P3P: policyref="/w3c/p3p.xml" cp="CAO DSP LAW CURa"
+
+Note that if a header value contains a carriage return, a leading space will be
+added to each new line that doesn't already have one as specified by RFC2616
+section 4.2. For example:
+
+ print header( -ingredients => "ham\neggs\nbacon" );
+
+will generate
+
+ Ingredients: ham
+ eggs
+ bacon
=head2 GENERATING A REDIRECTION HEADER
@@ -6198,12 +6222,12 @@
# undef may be returned if it's not a valid file handle
if (defined $lightweight_fh) {
# Upgrade the handle to one compatible with IO::Handle:
- my $io_handle = $lightweight_fh->handle;
-
- open (OUTFILE,">>/usr/local/web/users/feedback");
- while ($bytesread = $io_handle->read($buffer,1024)) {
- print OUTFILE $buffer;
- }
+ my $io_handle = $lightweight_fh->handle;
+
+ open (OUTFILE,'>>','/usr/local/web/users/feedback');
+ while ($bytesread = $io_handle->read($buffer,1024)) {
+ print OUTFILE $buffer;
+ }
}
In a list context, upload() will return an array of filehandles.
@@ -8024,13 +8048,12 @@
}
sub do_work {
- my(@values,$key);
print "<h2>Here are the current settings in this form</h2>";
- for $key (param) {
+ for my $key (param) {
print "<strong>$key</strong> -> ";
- @values = param($key);
+ my @values = param($key);
print join(", ", at values),"<br>\n";
}
}
Modified: trunk/libcgi-pm-perl/lib/CGI/Carp.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libcgi-pm-perl/lib/CGI/Carp.pm?rev=52306&op=diff
==============================================================================
--- trunk/libcgi-pm-perl/lib/CGI/Carp.pm (original)
+++ trunk/libcgi-pm-perl/lib/CGI/Carp.pm Sun Feb 7 22:57:46 2010
@@ -423,35 +423,26 @@
sub die {
my ($arg, at rest) = @_;
- if ($DIE_HANDLER) {
- &$DIE_HANDLER($arg, at rest);
- }
-
- if ( ineval() ) {
- if (!ref($arg)) {
- $arg = join("",($arg, at rest)) || "Died";
- my($file,$line,$id) = id(1);
- $arg .= " at $file line $line.\n" unless $arg=~/\n$/;
- realdie($arg);
- }
- else {
- realdie($arg, at rest);
- }
- }
-
- if (!ref($arg)) {
- $arg = join("", ($arg, at rest));
- my($file,$line,$id) = id(1);
- $arg .= " at $file line $line." unless $arg=~/\n$/;
- &fatalsToBrowser($arg) if $WRAP;
- if (($arg =~ /\n$/) || !exists($ENV{MOD_PERL})) {
- my $stamp = stamp;
- $arg=~s/^/$stamp/gm;
- }
- if ($arg !~ /\n$/) {
- $arg .= "\n";
- }
- }
+ &$DIE_HANDLER($arg, at rest) if $DIE_HANDLER;
+
+ # if called as die( $object, 'string' ),
+ # all is stringified, just like with
+ # the real 'die'
+ $arg = join '' => "$arg", @rest if @rest;
+
+ $arg ||= 'Died';
+
+ my($file,$line,$id) = id(1);
+
+ $arg .= " at $file line $line.\n" unless ref $arg or $arg=~/\n$/;
+
+ realdie $arg if ineval();
+ &fatalsToBrowser($arg) if $WRAP;
+
+ $arg=~s/^/ stamp() /gme if $arg =~ /\n$/ or not exists $ENV{MOD_PERL};
+
+ $arg .= "\n" unless $arg =~ /\n$/;
+
realdie $arg;
}
@@ -503,11 +494,15 @@
# headers
sub fatalsToBrowser {
- my($msg) = @_;
+ my $msg = shift;
+
+ $msg = "$msg" if ref $msg;
+
$msg=~s/&/&/g;
$msg=~s/>/>/g;
$msg=~s/</</g;
- $msg=~s/\"/"/g;
+ $msg=~s/"/"/g;
+
my($wm) = $ENV{SERVER_ADMIN} ?
qq[the webmaster (<a href="mailto:$ENV{SERVER_ADMIN}">$ENV{SERVER_ADMIN}</a>)] :
"this site's webmaster";
Modified: trunk/libcgi-pm-perl/lib/CGI/Cookie.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libcgi-pm-perl/lib/CGI/Cookie.pm?rev=52306&op=diff
==============================================================================
--- trunk/libcgi-pm-perl/lib/CGI/Cookie.pm (original)
+++ trunk/libcgi-pm-perl/lib/CGI/Cookie.pm Sun Feb 7 22:57:46 2010
@@ -1,4 +1,7 @@
package CGI::Cookie;
+
+use strict;
+use warnings;
# See the bottom of this file for the POD documentation. Search for the
# string '=head'.
@@ -78,14 +81,13 @@
$r ||= eval { $MOD_PERL == 2 ?
Apache2::RequestUtil->request() :
Apache->request } if $MOD_PERL;
- if ($r) {
- $raw_cookie = $r->headers_in->{'Cookie'};
- } else {
- if ($MOD_PERL && !exists $ENV{REQUEST_METHOD}) {
- die "Run $r->subprocess_env; before calling fetch()";
- }
- $raw_cookie = $ENV{HTTP_COOKIE} || $ENV{COOKIE};
- }
+
+ return $r->headers_in->{'Cookie'} if $r;
+
+ die "Run $r->subprocess_env; before calling fetch()"
+ if $MOD_PERL and !exists $ENV{REQUEST_METHOD};
+
+ return $ENV{HTTP_COOKIE} || $ENV{COOKIE};
}
@@ -122,7 +124,8 @@
shift if ref $_[0]
&& eval { $_[0]->isa('Apache::Request::Req') || $_[0]->isa('Apache') };
my($name,$value,$path,$domain,$secure,$expires,$httponly) =
- rearrange([NAME,[VALUE,VALUES],PATH,DOMAIN,SECURE,EXPIRES,HTTPONLY], at _);
+ rearrange([ 'NAME', ['VALUE','VALUES'], qw/ PATH DOMAIN SECURE EXPIRES
+ HTTPONLY / ], @_);
# Pull out our parameters.
my @values;
Modified: trunk/libcgi-pm-perl/lib/CGI/Fast.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libcgi-pm-perl/lib/CGI/Fast.pm?rev=52306&op=diff
==============================================================================
--- trunk/libcgi-pm-perl/lib/CGI/Fast.pm (original)
+++ trunk/libcgi-pm-perl/lib/CGI/Fast.pm Sun Feb 7 22:57:46 2010
@@ -1,6 +1,10 @@
package CGI::Fast;
use strict;
-$^W=1; # A way to say "use warnings" that's compatible with even older perls.
+
+# A way to say "use warnings" that's compatible with even older perls.
+# making it local will not affect the code that loads this module
+# and since we're not in a BLOCK, warnings are enabled until the EOF
+local $^W = 1;
# See the bottom of this file for the POD documentation. Search for the
# string '=head'.
@@ -15,7 +19,7 @@
# wish, but if you redistribute a modified version, please attach a note
# listing the modifications you have made.
-$CGI::Fast::VERSION='1.07';
+$CGI::Fast::VERSION='1.08';
use CGI;
use FCGI;
Modified: trunk/libcgi-pm-perl/lib/CGI/Util.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libcgi-pm-perl/lib/CGI/Util.pm?rev=52306&op=diff
==============================================================================
--- trunk/libcgi-pm-perl/lib/CGI/Util.pm (original)
+++ trunk/libcgi-pm-perl/lib/CGI/Util.pm Sun Feb 7 22:57:46 2010
@@ -244,11 +244,38 @@
# was always so and cannot be fixed without breaking the binary data case.
# -- Stepan Kasal <skasal at redhat.com>
#
+if ($] == 5.008) {
+ package utf8;
+
+ no warnings 'redefine'; # needed for Perl 5.8.1+
+
+ my $is_utf8_redefinition = <<'EOR';
+ sub is_utf8 {
+ my ($text) = @_;
+
+ my $ctext = pack q{C0a*}, $text;
+
+ return ($text ne $ctext) && ($ctext =~ m/^(
+ [\x09\x0A\x0D\x20-\x7E]
+ | [\xC2-\xDF][\x80-\xBF]
+ | \xE0[\xA0-\xBF][\x80-\xBF]
+ | [\xE1-\xEC\xEE\xEF][\x80-\xBF]{2}
+ | \xED[\x80-\x9F][\x80-\xBF]
+ | \xF0[\x90-\xBF][\x80-\xBF]{2}
+ | [\xF1-\xF3][\x80-\xBF]{3}
+ | \xF4[\x80-\x8F][\x80-\xBF]{2}
+ )*$/xo);
+ }
+EOR
+
+ eval $is_utf8_redefinition;
+}
+
sub escape {
shift() if @_ > 1 and ( ref($_[0]) || (defined $_[1] && $_[0] eq $CGI::DefaultClass));
my $toencode = shift;
return undef unless defined($toencode);
- utf8::encode($toencode) if ($] > 5.008001 && utf8::is_utf8($toencode));
+ utf8::encode($toencode) if ($] >= 5.008 && utf8::is_utf8($toencode));
if ($EBCDIC) {
$toencode=~s/([^a-zA-Z0-9_.~-])/uc sprintf("%%%02x",$E2A[ord($1)])/eg;
} else {
Modified: trunk/libcgi-pm-perl/t/carp.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libcgi-pm-perl/t/carp.t?rev=52306&op=diff
==============================================================================
--- trunk/libcgi-pm-perl/t/carp.t (original)
+++ trunk/libcgi-pm-perl/t/carp.t Sun Feb 7 22:57:46 2010
@@ -3,7 +3,7 @@
use strict;
-use Test::More tests => 41;
+use Test::More tests => 59;
use IO::Handle;
BEGIN { use_ok('CGI::Carp') };
@@ -116,12 +116,13 @@
# Test that realwarn is called
{
local $^W = 0;
- eval 'sub CGI::Carp::realdie {my $mess = shift; return $mess};';
-}
-
-like(CGI::Carp::die('There is a problem'),
- $stamp,
- 'CGI::Carp::die calls CORE::die, but adds stamp');
+ local *CGI::Carp::realdie = sub { my $mess = shift; return $mess };
+
+ like(CGI::Carp::die('There is a problem'),
+ $stamp,
+ 'CGI::Carp::die calls CORE::die, but adds stamp');
+
+}
#-----------------------------------------------------------------------------
# Test set_message
@@ -273,3 +274,100 @@
ok( defined buffer('::STDOUT'), 'STDIN returns proper filehandle');
ok( defined buffer(*main::STDOUT), 'STDIN returns proper filehandle');
ok(!defined buffer("WIBBLE"), '"WIBBLE" doesn\'t returns proper filehandle');
+
+# Calling die with code refs with no WRAP
+{
+ local $CGI::Carp::WRAP = 0;
+
+ eval { CGI::Carp::die( 'regular string' ) };
+ like $@ => qr/regular string/, 'die with string';
+
+ eval { CGI::Carp::die( [ 1..10 ] ) };
+ like $@ => qr/ARRAY\(0x[\da-f]+\)/, 'die with array ref';
+
+ eval { CGI::Carp::die( { a => 1 } ) };
+ like $@ => qr/HASH\(0x[\da-f]+\)/, 'die with hash ref';
+
+ eval { CGI::Carp::die( sub { 'Farewell' } ) };
+ like $@ => qr/CODE\(0x[\da-f]+\)/, 'die with code ref';
+
+ eval { CGI::Carp::die( My::Plain::Object->new ) };
+ isa_ok $@, 'My::Plain::Object';
+
+ eval { CGI::Carp::die( My::Plain::Object->new, ' and another argument' ) };
+ like $@ => qr/My::Plain::Object/, 'object is stringified';
+ like $@ => qr/and another argument/, 'second argument is present';
+
+ eval { CGI::Carp::die( My::Stringified::Object->new ) };
+ isa_ok $@, 'My::Stringified::Object';
+
+ eval { CGI::Carp::die( My::Stringified::Object->new, ' and another argument' ) };
+ like $@ => qr/stringified/, 'object is stringified';
+ like $@ => qr/and another argument/, 'second argument is present';
+
+ eval { CGI::Carp::die() };
+ like $@ => qr/Died at/, 'die with no argument';
+}
+
+# Calling die with code refs when WRAPped
+{
+ local $CGI::Carp::WRAP = 1;
+ local *CGI::Carp::realdie = sub { return @_ };
+ local *STDOUT;
+
+ tie *STDOUT, 'StoreStuff';
+
+ my %result; # store results because stdout is kidnapped
+
+ CGI::Carp::die( 'regular string' );
+ $result{string} .= $_ while <STDOUT>;
+
+ CGI::Carp::die( [ 1..10 ] );
+ $result{array_ref} .= $_ while <STDOUT>;
+
+ CGI::Carp::die( { a => 1 } );
+ $result{hash_ref} .= $_ while <STDOUT>;
+
+ CGI::Carp::die( sub { 'Farewell' } );
+ $result{code_ref} .= $_ while <STDOUT>;
+
+ CGI::Carp::die( My::Plain::Object->new );
+ $result{plain_object} .= $_ while <STDOUT>;
+
+ CGI::Carp::die( My::Stringified::Object->new );
+ $result{string_object} .= $_ while <STDOUT>;
+
+ CGI::Carp::die();
+ $result{no_args} .= $_ while <STDOUT>;
+
+ untie *STDOUT;
+
+ like $result{string} => qr/regular string/, 'regular string, wrapped';
+ like $result{array_ref} => qr/ARRAY\(\w+?\)/, 'array ref, wrapped';
+ like $result{hash_ref} => qr/HASH\(\w+?\)/, 'hash ref, wrapped';
+ like $result{code_ref} => qr/CODE\(\w+?\)/, 'code ref, wrapped';
+ like $result{plain_object} => qr/My::Plain::Object/,
+ 'plain object, wrapped';
+ like $result{string_object} => qr/stringified/,
+ 'stringified object, wrapped';
+ like $result{no_args} => qr/Died at/, 'no args, wrapped';
+
+}
+
+{
+ package My::Plain::Object;
+
+ sub new {
+ return bless {}, shift;
+ }
+}
+
+{
+ package My::Stringified::Object;
+
+ use overload '""' => sub { 'stringified' };
+
+ sub new {
+ return bless {}, shift;
+ }
+}
Modified: trunk/libcgi-pm-perl/t/fast.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libcgi-pm-perl/t/fast.t?rev=52306&op=diff
==============================================================================
--- trunk/libcgi-pm-perl/t/fast.t (original)
+++ trunk/libcgi-pm-perl/t/fast.t Sun Feb 7 22:57:46 2010
@@ -1,4 +1,4 @@
-#!./perl -w
+#!perl -w
my $fcgi;
BEGIN {
@@ -14,9 +14,9 @@
() = $CGI::Fast::Ext_Request;
SKIP: {
- skip( 'FCGI not installed, cannot continue', 7 ) unless $fcgi;
+ skip( 'FCGI not installed, cannot continue', 10 ) unless $fcgi;
- use CGI::Fast;
+ require CGI::Fast;
ok( my $q = CGI::Fast->new(), 'created new CGI::Fast object' );
is( $q, $CGI::Q, 'checking to see if the object was stored properly' );
is( $q->param(), (), 'no params' );
Modified: trunk/libcgi-pm-perl/t/function.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libcgi-pm-perl/t/function.t?rev=52306&op=diff
==============================================================================
--- trunk/libcgi-pm-perl/t/function.t (original)
+++ trunk/libcgi-pm-perl/t/function.t Sun Feb 7 22:57:46 2010
@@ -32,11 +32,6 @@
if (ord("\t") != 9) { $CRLF = "\r\n"; }
-# Web servers on EBCDIC hosts are typically set up to do an EBCDIC -> ASCII
-# translation hence CRLF is used as \r\n within CGI.pm on such machines.
-
-if (ord("\t") != 9) { $CRLF = "\r\n"; }
-
# Set up a CGI environment
$ENV{REQUEST_METHOD}='GET';
$ENV{QUERY_STRING} ='game=chess&game=checkers&weather=dull';
More information about the Pkg-perl-cvs-commits
mailing list