diff -ur CGI/Changes CGI.pm-3.63/Changes
--- a/cpan/CGI/Changes Mon Mar 4 09:16:21 2013
+++ b/cpan/CGI.pm-3.63/Changes Wed Nov 14 17:43:13 2012
@@ -1,3 +1,54 @@
+Version 3.63 Nov 12, 2012
+
+ [SECURITY]
+ - CR escaping for Set-Cookie and P3P headers was improved. There was potential
+ for newline injection in these headers.
+ (Thanks to anazawa, https://github.com/markstos/CGI.pm/pull/23)
+
+Version 3.62, Nov 9th, 2012
+
+ [INTERNALS]
+ - Changed how the deprecated endform function was defined for compatibilty
+ with the development version of Perl.
+ - Fix failures in t/tmpdir.t when run as root
+ https://github.com/markstos/CGI.pm/issues/22, RT#80659)
+
+ - Made it possible to force a sorted order for things like hash
+ attributes so that tests are not dependent on a particular hash
+ ordering. This will be required in modern perls which will
+ change the ordering per process. (Yves, RT#80659)
+
+Version 3.61 Nov 2nd, 2012
+
+ (No code changes)
+
+ [INTERNALS]
+ - formatting of CGI::Carp documentation was improved. Thanks to benkasminbullock.
+ - un-TODO some tests in t/tmpdir.t that were passing in most cases.
+ More on this:
+ https://github.com/markstos/CGI.pm/issues/19#
+ https://github.com/markstos/CGI.pm/commit/cc73dc9807b0fabb56b3cdf1a9726588b2eda0f7
+
+Version 3.60 Aug 15th, 2012
+
+ [BUG FIXES]
+ - In some caes, When unescapeHTML() hit something it didn't recognize with an ampersand and
+ and semicolon, it would throw away the semicolon and ampersand. It now does a better job.
+ of preserving content it doesn't recognize. Thanks to [email protected] (RT#75595)
+ - Remove trailing newline after <form> tag inserted by startform and start_form. It can
+ cause rendering problems in some cases. Thanks to [email protected] (RT#67719)
+ - Workaround "Insecure Dependency" warning generated by some versions of Perl (RT#53733).
+ Thanks to [email protected], [email protected] and Anonymous Monk
+
+ [DOCUMENTATION]
+ - Clarify that when -status is used, the human-readable phase should be included, per RFC 2616.
+ Thanks to [email protected] (RT#76691).
+
+ [INTERNALS]
+ - More tests for header(), thanks to Ryo Anazawa.
+ - t/url.t has been fixed on VMS. Thanks to [email protected] (RT#72380)
+ - MANIFEST patched so that t/multipart_init.t is included again. Thanks to [email protected] (RT#76189)
+
Version 3.59 Dec 29th, 2011
[BUG FIXES]
Common subdirectories: CGI/examples and CGI.pm-3.63/examples
Common subdirectories: CGI/lib and CGI.pm-3.63/lib
Common subdirectories: CGI/t and CGI.pm-3.63/t
Only in CGI.pm-3.63/examples: WORLD_WRITABLE
Common subdirectories: CGI/lib/CGI and CGI.pm-3.63/lib/CGI
diff -ur CGI/lib/CGI.pm CGI.pm-3.63/lib/CGI.pm
--- a/cpan/CGI/lib/CGI.pm Mon Mar 4 09:16:21 2013
+++ b/cpan/CGI.pm-3.63/lib/CGI.pm Wed Nov 14 17:42:54 2012
@@ -20,7 +20,7 @@
# The revision is no longer being updated since moving to git.
$CGI::revision = '$Id: CGI.pm,v 1.266 2009/07/30 16:32:34 lstein Exp $';
-$CGI::VERSION='3.59';
+$CGI::VERSION='3.63';
# HARD-CODED LOCATION FOR FILE UPLOAD TEMPORARY FILES.
# UNCOMMENT THIS ONLY IF YOU KNOW WHAT YOU'RE DOING.
@@ -129,10 +129,6 @@
# ------------------ START OF THE LIBRARY ------------
-#### Method: endform
-# This method is DEPRECATED
-*endform = \&end_form;
-
# make mod_perlhappy
initialize_globals();
@@ -530,7 +526,7 @@
my $val = $QUERY_PARAM{$name}; # always an arrayref;
$self->param('-name'=>$name,'-value'=> $val);
if (defined $val and ref $val eq 'ARRAY') {
- for my $fh (grep {defined(fileno($_))} @$val) {
+ for my $fh (grep {defined($_) && ref($_) && defined(fileno($_))} @$val) {
seek($fh,0,0); # reset the filehandle.
}
@@ -812,7 +808,7 @@
# put a filehandle into binary mode (DOS)
sub binmode {
- return unless defined($_[1]) && defined fileno($_[1]);
+ return unless defined($_[1]) && ref ($_[1]) && defined fileno($_[1]);
CORE::binmode($_[1]);
}
@@ -1501,8 +1497,17 @@
'EXPIRES','NPH','CHARSET',
'ATTACHMENT','P3P'],@p);
+ # Since $cookie and $p3p may be array references,
+ # we must stringify them before CR escaping is done.
+ my @cookie;
+ for (ref($cookie) eq 'ARRAY' ? @{$cookie} : $cookie) {
+ my $cs = UNIVERSAL::isa($_,'CGI::Cookie') ? $_->as_string : $_;
+ push(@cookie,$cs) if defined $cs and $cs ne '';
+ }
+ $p3p = join ' ',@$p3p if ref($p3p) eq 'ARRAY';
+
# CR escaping for values, per RFC 822
- for my $header ($type,$status,$cookie,$target,$expires,$nph,$charset,$attachment,$p3p,@other) {
+ for my $header ($type,$status,@cookie,$target,$expires,$nph,$charset,$attachment,$p3p,@other) {
if (defined $header) {
# From RFC 822:
# Unfolding is accomplished by regarding CRLF immediately
@@ -1546,18 +1551,9 @@
push(@header,"Status: $status") if $status;
push(@header,"Window-Target: $target") if $target;
- if ($p3p) {
- $p3p = join ' ',@$p3p if ref($p3p) eq 'ARRAY';
- push(@header,qq(P3P: policyref="/w3c/p3p.xml", CP="$p3p"));
- }
+ push(@header,"P3P: policyref=\"/w3c/p3p.xml\", CP=\"$p3p\"") if $p3p;
# push all the cookies -- there may be several
- if ($cookie) {
- my(@cookie) = ref($cookie) && ref($cookie) eq 'ARRAY' ? @{$cookie} : $cookie;
- for (@cookie) {
- my $cs = UNIVERSAL::isa($_,'CGI::Cookie') ? $_->as_string : $_;
- push(@header,"Set-Cookie: $cs") if $cs ne '';
- }
- }
+ push(@header,map {"Set-Cookie: $_"} @cookie);
# if the user indicates an expiration time, then we need
# both an Expires and a Date header (so that the browser is
# uses OUR clock)
@@ -1904,7 +1900,7 @@
$action = qq(action="$action");
my($other) = @other ? " @other" : '';
$self->{'.parametersToAdd'}={};
- return qq/<form method="$method" $action enctype="$enctype"$other>\n/;
+ return qq/<form method="$method" $action enctype="$enctype"$other>/;
}
END_OF_FUNC
@@ -1938,7 +1934,7 @@
$action = qq(action="$action");
my($other) = @other ? " @other" : '';
$self->{'.parametersToAdd'}={};
- return qq/<form method="$method" $action enctype="$enctype"$other>\n/;
+ return qq/<form method="$method" $action enctype="$enctype"$other>/;
}
END_OF_FUNC
@@ -1960,6 +1956,7 @@
#### Method: end_form
# End a form
+# Note: This repeated below under the older name.
'end_form' => <<'END_OF_FUNC',
sub end_form {
my($self,@p) = self_or_default(@_);
@@ -1976,6 +1973,22 @@
}
END_OF_FUNC
+'endform' => <<'END_OF_FUNC',
+sub endform {
+ my($self,@p) = self_or_default(@_);
+ if ( $NOSTICKY ) {
+ return wantarray ? ("</form>") : "\n</form>";
+ } else {
+ if (my @fields = $self->get_fields) {
+ return wantarray ? ("<div>",@fields,"</div>","</form>")
+ : "<div>".(join '',@fields)."</div>\n</form>";
+ } else {
+ return "</form>";
+ }
+ }
+}
+END_OF_FUNC
+
#### Method: end_multipart_form
# end a multipart form
'end_multipart_form' => <<'END_OF_FUNC',
@@ -2311,7 +2324,7 @@
my $latin = defined $self->{'.charset'} ? $self->{'.charset'} =~ /^(ISO-8859-1|WINDOWS-1252)$/i
: 1;
# thanks to Randal Schwartz for the correct solution to this one
- $string=~ s[&(\S*?);]{
+ $string=~ s[&([^\s&]*?);]{
local $_ = $1;
/^amp$/i ? "&" :
/^quot$/i ? '"' :
@@ -2319,7 +2332,7 @@
/^lt$/i ? "<" :
/^#(\d+)$/ && $latin ? chr($1) :
/^#x([0-9a-f]+)$/i && $latin ? chr(hex($1)) :
- $_
+ "&$_;"
}gex;
return $string;
}
@@ -5184,7 +5197,8 @@
MIME type if you choose, otherwise it defaults to text/html. An
optional second parameter specifies the status code and a human-readable
message. For example, you can specify 204, "No response" to create a
-script that tells the browser to do nothing at all.
+script that tells the browser to do nothing at all. Note that RFC 2616 expects
+the human-readable phase to be there as well as the numeric status code.
The last example shows the named argument style for passing arguments
to the CGI methods using named parameters. Recognized parameters are
@@ -5272,7 +5286,7 @@
print $q->redirect(
-uri=>'http://somewhere.else/in/movie/land',
-nph=>1,
- -status=>301);
+ -status=>'301 Moved Permanently');
All names arguments recognized by header() are also recognized by
redirect(). However, most HTTP headers, including those generated by
@@ -5295,6 +5309,9 @@
advised that changing the status to anything other than 301, 302 or
303 will probably break redirection.
+Note that the human-readable phrase is also expected to be present to conform
+with RFC 2616, section 6.1.
+
=head2 CREATING THE HTML DOCUMENT HEADER
print start_html(-title=>'Secrets of the Pyramids',
diff -ur CGI/lib/CGI/Carp.pm CGI.pm-3.63/lib/CGI/Carp.pm
--- a/cpan/CGI/lib/CGI/Carp.pm Mon Mar 4 09:16:21 2013
+++ b/cpan/CGI.pm-3.63/lib/CGI/Carp.pm Fri Nov 2 19:33:07 2012
@@ -33,9 +33,9 @@
use CGI::Carp
-And the standard warn(), die (), croak(), confess() and carp() calls
-will automagically be replaced with functions that write out nicely
-time-stamped messages to the HTTP server error log.
+The standard warn(), die (), croak(), confess() and carp() calls will
+be replaced with functions that write time-stamped messages to the
+HTTP server error log.
For example:
@@ -57,10 +57,10 @@
use CGI::Carp qw(carpout);
-The carpout() function requires one argument, which should be a
-reference to an open filehandle for writing errors. It should be
-called in a C<BEGIN> block at the top of the CGI application so that
-compiler errors will be caught. Example:
+The carpout() function requires one argument, a reference to an open
+filehandle for writing errors. It should be called in a C<BEGIN>
+block at the top of the CGI application so that compiler errors will
+be caught. Example:
BEGIN {
use CGI::Carp qw(carpout);
@@ -69,14 +69,15 @@
carpout(LOG);
}
-carpout() does not handle file locking on the log for you at this point.
-Also, note that carpout() does not work with in-memory file handles, although
-a patch would be welcome to address that.
+carpout() does not handle file locking on the log for you at this
+point. Also, note that carpout() does not work with in-memory file
+handles, although a patch would be welcome to address that.
-The real STDERR is not closed -- it is moved to CGI::Carp::SAVEERR. Some
-servers, when dealing with CGI scripts, close their connection to the
-browser when the script closes STDOUT and STDERR. CGI::Carp::SAVEERR is there to
-prevent this from happening prematurely.
+The real STDERR is not closed -- it is moved to CGI::Carp::SAVEERR.
+Some servers, when dealing with CGI scripts, close their connection to
+the browser when the script closes STDOUT and STDERR.
+CGI::Carp::SAVEERR is there to prevent this from happening
+prematurely.
You can pass filehandles to carpout() in a variety of ways. The "correct"
way according to Tom Christiansen is to pass a reference to a filehandle
@@ -104,17 +105,17 @@
=head1 MAKING PERL ERRORS APPEAR IN THE BROWSER WINDOW
-If you want to send fatal (die, confess) errors to the browser, ask to
-import the special "fatalsToBrowser" subroutine:
+If you want to send fatal (die, confess) errors to the browser, import
+the special "fatalsToBrowser" subroutine:
use CGI::Carp qw(fatalsToBrowser);
die "Bad error here";
-Fatal errors will now be echoed to the browser as well as to the log. CGI::Carp
-arranges to send a minimal HTTP header to the browser so that even errors that
-occur in the early compile phase will be seen.
-Nonfatal errors will still be directed to the log file only (unless redirected
-with carpout).
+Fatal errors will now be echoed to the browser as well as to the log.
+CGI::Carp arranges to send a minimal HTTP header to the browser so
+that even errors that occur in the early compile phase will be seen.
+Nonfatal errors will still be directed to the log file only (unless
+redirected with carpout).
Note that fatalsToBrowser may B<not> work well with mod_perl version 2.0
and higher.
@@ -193,10 +194,10 @@
This may have some undesireable effects when the purpose of doing the
eval is to determine which of several algorithms is to be used.
-By setting C<$CGI::Carp::TO_BROWSER> to 0 you can suppress printing the C<die> messages
-but without all of the complexity of using C<set_die_handler>.
-You can localize this effect to inside C<eval> bodies if this is desireable:
-For example:
+By setting C<$CGI::Carp::TO_BROWSER> to 0 you can suppress printing
+the C<die> messages but without all of the complexity of using
+C<set_die_handler>. You can localize this effect to inside C<eval>
+bodies if this is desireable: For example:
eval {
local $CGI::Carp::TO_BROWSER = 0;
@@ -207,12 +208,12 @@
=head1 MAKING WARNINGS APPEAR AS HTML COMMENTS
-It is now also possible to make non-fatal errors appear as HTML
-comments embedded in the output of your program. To enable this
-feature, export the new "warningsToBrowser" subroutine. Since sending
-warnings to the browser before the HTTP headers have been sent would
-cause an error, any warnings are stored in an internal buffer until
-you call the warningsToBrowser() subroutine with a true argument:
+It is also possible to make non-fatal errors appear as HTML comments
+embedded in the output of your program. To enable this feature,
+export the new "warningsToBrowser" subroutine. Since sending warnings
+to the browser before the HTTP headers have been sent would cause an
+error, any warnings are stored in an internal buffer until you call
+the warningsToBrowser() subroutine with a true argument:
use CGI::Carp qw(fatalsToBrowser warningsToBrowser);
use CGI qw(:standard);
@@ -320,12 +321,10 @@
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.
-Address bug reports and comments to: [email protected]
-
=head1 SEE ALSO
-Carp, CGI::Base, CGI::BasePlus, CGI::Request, CGI::MiniSvr, CGI::Form,
-CGI::Response
+L<Carp>, L<CGI::Base>, L<CGI::BasePlus>, L<CGI::Request>,
+L<CGI::MiniSvr>, L<CGI::Form>, L<CGI::Response>.
=cut
diff -ur CGI/lib/CGI/Cookie.pm CGI.pm-3.63/lib/CGI/Cookie.pm
--- a/cpan/CGI/lib/CGI/Cookie.pm Mon Mar 4 09:16:21 2013
+++ b/cpan/CGI.pm-3.63/lib/CGI/Cookie.pm Wed Aug 15 20:07:03 2012
@@ -473,7 +473,7 @@
CGI::Cookie->fetch($r);
If the value passed to parse() is undefined, an empty array will returned in list
-contact, and an empty hashref will be returned in scalar context.
+context, and an empty hashref will be returned in scalar context.
=head2 Manipulating Cookies
diff -ur CGI/lib/CGI/Util.pm CGI.pm-3.63/lib/CGI/Util.pm
--- a/cpan/CGI/lib/CGI/Util.pm Mon Mar 4 09:16:21 2013
+++ b/cpan/CGI.pm-3.63/lib/CGI/Util.pm Fri Nov 9 19:19:12 2012
@@ -1,15 +1,19 @@
package CGI::Util;
+use base 'Exporter';
require 5.008001;
use strict;
-require Exporter;
-our @ISA = qw(Exporter);
-our @EXPORT_OK = qw(rearrange rearrange_header make_attributes unescape escape
- expires ebcdic2ascii ascii2ebcdic);
+our @EXPORT_OK = qw(rearrange rearrange_header make_attributes unescape escape
+ expires ebcdic2ascii ascii2ebcdic);
-our $VERSION = '3.53';
+our $VERSION = '3.62';
use constant EBCDIC => "\t" ne "\011";
+# This option is not documented and may change or go away.
+# The HTML spec does not require attributes to be sorted,
+# but it's useful for testing to get a predictable order back.
+our $SORT_ATTRIBUTES;
+
# (ord('^') == 95) for codepage 1047 as on os390, vmesa
our @A2E = (
0, 1, 2, 3, 55, 45, 46, 47, 22, 5, 21, 11, 12, 13, 14, 15,
@@ -28,7 +32,7 @@
172,105,237,238,235,239,236,191,128,253,254,251,252,186,174, 89,
68, 69, 66, 70, 67, 71,156, 72, 84, 81, 82, 83, 88, 85, 86, 87,
140, 73,205,206,203,207,204,225,112,221,222,219,220,141,142,223
- );
+ );
our @E2A = (
0, 1, 2, 3,156, 9,134,127,151,141,142, 11, 12, 13, 14, 15,
16, 17, 18, 19,157, 10, 8,135, 24, 25,146,143, 28, 29, 30, 31,
@@ -46,7 +50,7 @@
125, 74, 75, 76, 77, 78, 79, 80, 81, 82,185,251,252,249,250,255,
92,247, 83, 84, 85, 86, 87, 88, 89, 90,178,212,214,210,211,213,
48, 49, 50, 51, 52, 53, 54, 55, 56, 57,179,219,220,217,218,159
- );
+ );
if (EBCDIC && ord('^') == 106) { # as in the BS2000 posix-bc coded character set
$A2E[91] = 187; $A2E[92] = 188; $A2E[94] = 106; $A2E[96] = 74;
@@ -77,7 +81,7 @@
my ($order,@param) = @_;
my ($result, $leftover) = _rearrange_params( $order, @param );
push @$result, make_attributes( $leftover, defined $CGI::Q ? $CGI::Q->{escape} : 1 )
- if keys %$leftover;
+ if keys %$leftover;
@$result;
}
@@ -95,10 +99,10 @@
return [] unless @param;
if (ref($param[0]) eq 'HASH') {
- @param = %{$param[0]};
+ @param = %{$param[0]};
} else {
- return \@param
- unless (defined($param[0]) && substr($param[0],0,1) eq '-');
+ return \@param
+ unless (defined($param[0]) && substr($param[0],0,1) eq '-');
}
# map parameters into positional indices
@@ -105,21 +109,21 @@
my ($i,%pos);
$i = 0;
foreach (@$order) {
- foreach (ref($_) eq 'ARRAY' ? @$_ : $_) { $pos{lc($_)} = $i; }
- $i++;
+ foreach (ref($_) eq 'ARRAY' ? @$_ : $_) { $pos{lc($_)} = $i; }
+ $i++;
}
my (@result,%leftover);
$#result = $#$order; # preextend
while (@param) {
- my $key = lc(shift(@param));
- $key =~ s/^\-//;
- if (exists $pos{$key}) {
- $result[$pos{$key}] = shift(@param);
- } else {
- $leftover{$key} = shift(@param);
- }
+ my $key = lc(shift(@param));
+ $key =~ s/^\-//;
+ if (exists $pos{$key}) {
+ $result[$pos{$key}] = shift(@param);
+ } else {
+ $leftover{$key} = shift(@param);
}
+ }
return \@result, \%leftover;
}
@@ -132,18 +136,22 @@
my $quote = $do_not_quote ? '' : '"';
+ my @attr_keys= keys %$attr;
+ if ($SORT_ATTRIBUTES) {
+ @attr_keys= sort @attr_keys;
+ }
my(@att);
- foreach (keys %{$attr}) {
- my($key) = $_;
- $key=~s/^\-//; # get rid of initial - if present
+ foreach (@attr_keys) {
+ my($key) = $_;
+ $key=~s/^\-//; # get rid of initial - if present
- # old way: breaks EBCDIC!
- # $key=~tr/A-Z_/a-z-/; # parameters are lower case, use dashes
+ # old way: breaks EBCDIC!
+ # $key=~tr/A-Z_/a-z-/; # parameters are lower case, use dashes
- ($key="\L$key") =~ tr/_/-/; # parameters are lower case, use dashes
+ ($key="\L$key") =~ tr/_/-/; # parameters are lower case, use dashes
- my $value = $escape ? simple_escape($attr->{$_}) : $attr->{$_};
- push(@att,defined($attr->{$_}) ? qq/$key=$quote$value$quote/ : qq/$key/);
+ my $value = $escape ? simple_escape($attr->{$_}) : $attr->{$_};
+ push(@att,defined($attr->{$_}) ? qq/$key=$quote$value$quote/ : qq/$key/);
}
return @att;
}
@@ -176,19 +184,19 @@
if (EBCDIC) {
$todecode =~ s/%([0-9a-fA-F]{2})/chr $A2E[hex($1)]/ge;
} else {
- # handle surrogate pairs first -- dankogai. Ref: http://unicode.org/faq/utf_bom.html#utf16-2
- $todecode =~ s{
- %u([Dd][89a-bA-B][0-9a-fA-F]{2}) # hi
- %u([Dd][c-fC-F][0-9a-fA-F]{2}) # lo
- }{
- utf8_chr(
- 0x10000
- + (hex($1) - 0xD800) * 0x400
- + (hex($2) - 0xDC00)
- )
- }gex;
+ # handle surrogate pairs first -- dankogai. Ref: http://unicode.org/faq/utf_bom.html#utf16-2
+ $todecode =~ s{
+ %u([Dd][89a-bA-B][0-9a-fA-F]{2}) # hi
+ %u([Dd][c-fC-F][0-9a-fA-F]{2}) # lo
+ }{
+ utf8_chr(
+ 0x10000
+ + (hex($1) - 0xD800) * 0x400
+ + (hex($2) - 0xDC00)
+ )
+ }gex;
$todecode =~ s/%(?:([0-9a-fA-F]{2})|u([0-9a-fA-F]{4}))/
- defined($1)? chr hex($1) : utf8_chr(hex($2))/ge;
+ defined($1)? chr hex($1) : utf8_chr(hex($2))/ge;
}
return $todecode;
}
diff -ur CGI/t/autoescape.t CGI.pm-3.63/t/autoescape.t
--- a/cpan/CGI/t/autoescape.t Mon Mar 4 09:15:24 2013
+++ b/cpan/CGI.pm-3.63/t/autoescape.t Fri Nov 9 19:20:03 2012
@@ -6,6 +6,7 @@
use Test::More tests => 18;
use CGI qw/ autoEscape escapeHTML button textfield password_field textarea popup_menu scrolling_list checkbox_group optgroup checkbox radio_group submit image_button button /;
+$CGI::Util::SORT_ATTRIBUTES = 1;
is (button(-name => 'test<'), '<input type="button" name="test<" value="test<" />', "autoEscape defaults to On");
Only in CGI.pm-3.63/t: fast.t
diff -ur CGI/t/form.t CGI.pm-3.63/t/form.t
--- a/cpan/CGI/t/form.t Mon Mar 4 09:15:24 2013
+++ b/cpan/CGI.pm-3.63/t/form.t Wed Aug 15 22:01:10 2012
@@ -27,7 +27,7 @@
$ENV{SERVER_NAME} = 'the.good.ship.lollypop.com';
is(start_form(-action=>'foobar',-method=>'get'),
- qq(<form method="get" action="foobar" enctype="multipart/form-data">\n),
+ qq(<form method="get" action="foobar" enctype="multipart/form-data">),
"start_form()");
is(submit(),
@@ -189,28 +189,23 @@
$CGI::XHTML = 1;
is(start_form("GET","/foobar"),
- qq{<form method="get" action="/foobar" enctype="multipart/form-data">
-},
+ qq{<form method="get" action="/foobar" enctype="multipart/form-data">},
'start_form() + XHTML');
is(start_form("GET", "/foobar",&CGI::URL_ENCODED),
- qq{<form method="get" action="/foobar" enctype="application/x-www-form-urlencoded">
-},
+ qq{<form method="get" action="/foobar" enctype="application/x-www-form-urlencoded">},
'start_form() + XHTML + URL_ENCODED');
is(start_form("GET", "/foobar",&CGI::MULTIPART),
- qq{<form method="get" action="/foobar" enctype="multipart/form-data">
-},
+ qq{<form method="get" action="/foobar" enctype="multipart/form-data">},
'start_form() + XHTML + MULTIPART');
is(start_multipart_form("GET", "/foobar"),
- qq{<form method="get" action="/foobar" enctype="multipart/form-data">
-},
+ qq{<form method="get" action="/foobar" enctype="multipart/form-data">},
'start_multipart_form() + XHTML');
is(start_multipart_form("GET", "/foobar","name=\"foobar\""),
- qq{<form method="get" action="/foobar" enctype="multipart/form-data" name="foobar">
-},
+ qq{<form method="get" action="/foobar" enctype="multipart/form-data" name="foobar">},
'start_multipart_form() + XHTML + additional args');
# set no XHTML
@@ -217,28 +212,23 @@
$CGI::XHTML = 0;
is(start_form("GET","/foobar"),
- qq{<form method="get" action="/foobar" enctype="application/x-www-form-urlencoded">
-},
+ qq{<form method="get" action="/foobar" enctype="application/x-www-form-urlencoded">},
'start_form() + NO_XHTML');
is(start_form("GET", "/foobar",&CGI::URL_ENCODED),
- qq{<form method="get" action="/foobar" enctype="application/x-www-form-urlencoded">
-},
+ qq{<form method="get" action="/foobar" enctype="application/x-www-form-urlencoded">},
'start_form() + NO_XHTML + URL_ENCODED');
is(start_form("GET", "/foobar",&CGI::MULTIPART),
- qq{<form method="get" action="/foobar" enctype="multipart/form-data">
-},
+ qq{<form method="get" action="/foobar" enctype="multipart/form-data">},
'start_form() + NO_XHTML + MULTIPART');
is(start_multipart_form("GET", "/foobar"),
- qq{<form method="get" action="/foobar" enctype="multipart/form-data">
-},
+ qq{<form method="get" action="/foobar" enctype="multipart/form-data">},
'start_multipart_form() + NO_XHTML');
is(start_multipart_form("GET", "/foobar","name=\"foobar\""),
- qq{<form method="get" action="/foobar" enctype="multipart/form-data" name="foobar">
-},
+ qq{<form method="get" action="/foobar" enctype="multipart/form-data" name="foobar">},
'start_multipart_form() + NO_XHTML + additional args');
# restoring value
diff -ur CGI/t/function.t CGI.pm-3.63/t/function.t
--- a/cpan/CGI/t/function.t Mon Mar 4 09:15:24 2013
+++ b/cpan/CGI.pm-3.63/t/function.t Fri Nov 9 19:21:09 2012
@@ -5,6 +5,7 @@
use Config;
use CGI (':standard','keywords');
$loaded = 1;
+$CGI::Util::SORT_ATTRIBUTES = 1;
print "ok 1\n";
######################### End of black magic.
@@ -103,4 +104,4 @@
test(31, header(-foo=>'bar') eq "Foo: bar${CRLF}Content-Type: text/html${CRLF}${CRLF}", "Custom header");
-test(32, start_form(-action=>'one',name=>'two',onsubmit=>'three') eq qq(<form method="post" action="one" enctype="multipart/form-data" onsubmit="three" name="two">\n), "initial dash followed by undashed arguments");
+test(32, start_form(-action=>'one',name=>'two',onsubmit=>'three') eq qq(<form method="post" action="one" enctype="multipart/form-data" name="two" onsubmit="three">), "initial dash followed by undashed arguments")
Only in CGI.pm-3.63/t: gen-tests
diff -ur CGI/t/headers.t CGI.pm-3.63/t/headers.t
--- a/cpan/CGI/t/headers.t Mon Mar 4 09:15:24 2013
+++ b/cpan/CGI.pm-3.63/t/headers.t Wed Nov 14 17:39:38 2012
@@ -22,6 +22,12 @@
like $cgi->header( -type => "text/html".$CGI::CRLF." evil: stuff " ),
qr#Content-Type: text/html evil: stuff#, 'known header, with leading and trailing whitespace on the continuation line';
+eval { $cgi->header( -p3p => ["foo".$CGI::CRLF."bar"] ) };
+like($@,qr/contains a newline/,'P3P header with CRLF embedded blows up');
+
+eval { $cgi->header( -cookie => ["foo".$CGI::CRLF."bar"] ) };
+like($@,qr/contains a newline/,'Set-Cookie header with CRLF embedded blows up');
+
eval { $cgi->header( -foobar => "text/html".$CGI::CRLF."evil: stuff" ) };
like($@,qr/contains a newline/,'unknown header with CRLF embedded blows up');
diff -ur CGI/t/html.t CGI.pm-3.63/t/html.t
--- a/cpan/CGI/t/html.t Mon Mar 4 09:16:21 2013
+++ b/cpan/CGI.pm-3.63/t/html.t Fri Nov 9 19:21:53 2012
@@ -5,6 +5,7 @@
END { ok $loaded; }
use CGI ( ':standard', '-no_debug', '*h3', 'start_table' );
$loaded = 1;
+$CGI::Util::SORT_ATTRIBUTES= 1;
ok 1;
BEGIN {
@@ -98,7 +99,7 @@
<html xmlns="http://www.w3.org/1999/xhtml" lang="en-US" xml:lang="en-US">
<head>
<title>The world of foo</title>
-<script src="foo.js" charset="utf-8" type="text/javascript"></script>
+<script charset="utf-8" src="foo.js" type="text/javascript"></script>
<meta http-equiv="Content-Type" content="text/html; charset=iso-8859-1" />
</head>
<body>
Only in CGI.pm-3.63/t: multipart_init.t
diff -ur CGI/t/tmpdir.t CGI.pm-3.63/t/tmpdir.t
--- a/cpan/CGI/t/tmpdir.t Mon Mar 4 09:16:21 2013
+++ b/cpan/CGI.pm-3.63/t/tmpdir.t Fri Nov 9 19:10:44 2012
@@ -1,7 +1,11 @@
#!perl
-use Test::More tests => 9;
+use Test::More;
use strict;
+if( $> == 0 ) {
+ plan skip_all => "Root can write to 'unwritable files', so many of these tests don't make sense for root.";
+}
+
my ($testdir, $testdir2);
BEGIN {
@@ -20,21 +24,20 @@
CGITempFile->new;
is($CGITempFile::TMPDIRECTORY, $testdir, "\$CGITempFile::TMPDIRECTORY unchanged");
-TODO: {
- local $TODO = "figuring out why these tests fail on some platforms";
- ok(chmod 0500, $testdir, "revoking write access to $testdir");
- ok(! -w $testdir, "write access to $testdir revoked");
+ok(chmod 0500, $testdir, "revoking write access to $testdir");
+ok(! -w $testdir, "write access to $testdir revoked");
CGITempFile->new;
is($CGITempFile::TMPDIRECTORY, $testdir2,
- "unwritable \$CGITempFile::TMPDIRECTORY overridden");
+ "unwritable \$CGITempFile::TMPDIRECTORY overridden");
ok(chmod 0500, $testdir2, "revoking write access to $testdir2");
ok(! -w $testdir, "write access to $testdir revoked");
CGITempFile->new;
isnt($CGITempFile::TMPDIRECTORY, $testdir2,
- "unwritable \$ENV{TMPDIR} overridden");
+ "unwritable \$ENV{TMPDIR} overridden");
isnt($CGITempFile::TMPDIRECTORY, $testdir,
- "unwritable \$ENV{TMPDIR} not overridden with an unwritable \$CGITempFile::TMPDIRECTORY");
-}
+ "unwritable \$ENV{TMPDIR} not overridden with an unwritable \$CGITempFile::TMPDIRECTORY");
+done_testing();
+
END { for ($testdir, $testdir2) { chmod 0700, $_; rmdir; } }
diff -ur CGI/t/unescapeHTML.t CGI.pm-3.63/t/unescapeHTML.t
--- a/cpan/CGI/t/unescapeHTML.t Mon Mar 4 09:15:24 2013
+++ b/cpan/CGI.pm-3.63/t/unescapeHTML.t Wed Aug 15 21:00:12 2012
@@ -1,4 +1,4 @@
-use Test::More tests => 4;
+use Test::More tests => 6;
use CGI 'unescapeHTML';
is( unescapeHTML( '&'), '&', 'unescapeHTML: &');
@@ -6,3 +6,7 @@
is( unescapeHTML( '<'), '<', 'unescapeHTML: < (using a numbered sequence)');
is( unescapeHTML( 'Bob & Tom went to the store; Where did you go?'),
'Bob & Tom went to the store; Where did you go?', 'unescapeHTML: a case where &...; should not be escaped.');
+is( unescapeHTML( 'This_string_contains_both_escaped_&_unescaped_<entities>'),
+ 'This_string_contains_both_escaped_&_unescaped_<entities>', 'unescapeHTML: partially-escaped string.');
+is( unescapeHTML( 'This escaped string kind of looks like it has an escaped entity &x; it does not'),
+ 'This escaped string kind of looks like it has an escaped entity &x; it does not', 'unescapeHTML: Another case where &...; should not be escaped.');