This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Upgrade to CGI 3.60
authorSteve Hay <steve.m.hay@googlemail.com>
Thu, 16 Aug 2012 07:30:57 +0000 (08:30 +0100)
committerSteve Hay <steve.m.hay@googlemail.com>
Thu, 16 Aug 2012 07:33:34 +0000 (08:33 +0100)
There were already no t/lib/Test or cgi-lib_porting.html files, so these
can be removed from EXCLUDED.

MANIFEST
Porting/Maintainers.pl
cpan/CGI/Changes
cpan/CGI/lib/CGI.pm
cpan/CGI/lib/CGI/Cookie.pm
cpan/CGI/t/form.t
cpan/CGI/t/function.t
cpan/CGI/t/multipart_init.t [new file with mode: 0644]
cpan/CGI/t/unescapeHTML.t
pod/perldelta.pod

index 5e45afc..6834d86 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -191,8 +191,9 @@ cpan/CGI/t/html.t                   See if CGI.pm works
 cpan/CGI/t/http.t                      See if CGI.pm works
 cpan/CGI/t/init.t                      See if CGI.pm works
 cpan/CGI/t/init_test.txt               See if CGI.pm works
+cpan/CGI/t/multipart_init.t            See if CGI.pm works
 cpan/CGI/t/no_tabindex.t               See if CGI.pm works
-cpan/CGI/t/param_fetch.t                       See if CGI pop menus work
+cpan/CGI/t/param_fetch.t               See if CGI pop menus work
 cpan/CGI/t/popup_menu.t                        See if CGI pop menus work
 cpan/CGI/t/pretty.t                    See if CGI.pm works
 cpan/CGI/t/push.t                      See if CGI::Push works
index 99b6601..4302015 100755 (executable)
@@ -342,12 +342,10 @@ use File::Glob qw(:case);
 
     'CGI' => {
         'MAINTAINER'   => 'lstein',
-        'DISTRIBUTION' => 'MARKSTOS/CGI.pm-3.59.tar.gz',
+        'DISTRIBUTION' => 'MARKSTOS/CGI.pm-3.60.tar.gz',
         'FILES'        => q[cpan/CGI],
         'EXCLUDED'     => [
-            qr{^t/lib/Test},
-            qw( cgi-lib_porting.html
-                cgi_docs.html
+            qw( cgi_docs.html
                 examples/WORLD_WRITABLE/18.157.1.253.sav
                 t/gen-tests/gen-start-end-tags.pl
                 t/fast.t
index 07bd6fd..68ef980 100644 (file)
@@ -1,3 +1,23 @@
+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 CEBJYRE@cpan.org (RT#75595)
+  - Remove trailing newline after <form> tag inserted by startform and start_form. It can
+    cause rendering problems in some cases. Thanks to SJOHNSTON@cpan.org (RT#67719)
+  - Workaround "Insecure Dependency" warning generated by some versions of Perl (RT#53733).
+    Thanks to degatcpan@ntlworld.com, klchu@lbl.gov and Anonymous Monk 
+
+  [DOCUMENTATION] 
+  - Clarify that when -status is used, the human-readable phase should be included, per RFC 2616.
+    Thanks to SREZIC@cpan.org (RT#76691). 
+
+  [INTERNALS]
+  - More tests for header(), thanks to Ryo Anazawa.
+  - t/url.t has been fixed on VMS. Thanks to cberry@cpan.org (RT#72380)
+  - MANIFEST patched so that t/multipart_init.t is included again. Thanks to shay@cpan.org (RT#76189)
+
 Version 3.59 Dec 29th, 2011
 
  [BUG FIXES]
index 6084f0f..f510680 100644 (file)
@@ -20,7 +20,7 @@ use Carp 'croak';
 
 # 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.60';
 
 # HARD-CODED LOCATION FOR FILE UPLOAD TEMPORARY FILES.
 # UNCOMMENT THIS ONLY IF YOU KNOW WHAT YOU'RE DOING.
@@ -530,7 +530,7 @@ sub init {
             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 +812,7 @@ sub all_parameters {
 
 # 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]);
 }
 
@@ -1904,7 +1904,7 @@ sub startform {
     $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 +1938,7 @@ sub start_form {
     $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
 
@@ -2311,7 +2311,7 @@ sub unescapeHTML {
     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 +2319,7 @@ sub unescapeHTML {
        /^lt$/i         ? "<" :
        /^#(\d+)$/ && $latin         ? chr($1) :
        /^#x([0-9a-f]+)$/i && $latin ? chr(hex($1)) :
-       $_
+       "&$_;"
        }gex;
     return $string;
 }
@@ -5184,7 +5184,8 @@ header() returns the Content-type: header.  You can provide your own
 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 +5273,7 @@ You can also use named arguments:
     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 +5296,9 @@ You may change the status to another status code if you wish.  Be
 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',
index df344ff..da916ac 100644 (file)
@@ -473,7 +473,7 @@ passing the request object to fetch() like this:
    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
 
index a8373c6..0a90b9c 100644 (file)
@@ -27,7 +27,7 @@ $ENV{SERVER_PORT}     = 8080;
 $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,56 +189,46 @@ my $saved_XHTML = $CGI::XHTML;
 $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
 $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
index 1013339..e0c0845 100644 (file)
@@ -103,4 +103,4 @@ test(30, !charset("") && header() eq "Content-Type: text/html${CRLF}${CRLF}", "E
 
 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" onsubmit="three" name="two">), "initial dash followed by undashed arguments");
diff --git a/cpan/CGI/t/multipart_init.t b/cpan/CGI/t/multipart_init.t
new file mode 100644 (file)
index 0000000..68ae05c
--- /dev/null
@@ -0,0 +1,22 @@
+use Test::More 'no_plan';
+
+use CGI;
+
+my $q = CGI->new;
+
+my $sv = $q->multipart_init;
+like( $sv, qr|Content-Type: multipart/x-mixed-replace;boundary="------- =|, 'multipart_init(), basic');
+
+like( $sv, qr/$CGI::CRLF$/, 'multipart_init(), ends in CRLF' );
+
+$sv = $q->multipart_init( 'this_is_the_boundary' );
+like( $sv, qr/boundary="this_is_the_boundary"/, 'multipart_init("simple_boundary")' );
+$sv = $q->multipart_init( -boundary => 'this_is_another_boundary' );
+like($sv,
+     qr/boundary="this_is_another_boundary"/, "multipart_init( -boundary => 'this_is_another_boundary')");
+
+{
+    my $sv = $q->multipart_init;
+    my $sv2 = $q->multipart_init;
+    isnt($sv,$sv2,"due to random boundaries, multiple calls produce different results");
+}
index 8ae302c..73bb57f 100644 (file)
@@ -1,4 +1,4 @@
-use Test::More tests => 4;
+use Test::More tests => 6;
 use CGI 'unescapeHTML';
 
 is( unescapeHTML( '&amp;'), '&', 'unescapeHTML: &');
@@ -6,3 +6,7 @@ is( unescapeHTML( '&quot;'), '"', 'unescapeHTML: "');
 is( unescapeHTML( '&#60;'), '<', '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_&lt;entities&gt;'), 
+    '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.');
index 4c59b20..105b8af 100644 (file)
@@ -137,6 +137,14 @@ C<format> line are also now deparsed correctly.
 
 =item *
 
+L<CGI> has been upgraded from version 3.59 to 3.60.  Unrecognized HTML escape
+sequences are now handled better, problematic trailing newlines are no longer
+inserted after L<lt>formL<gt> tags by C<startform()> or C<start_form()>, and
+bogus "Insecure Dependency" warnings appearing with some versions of perl are
+now worked around.
+
+=item *
+
 L<Compress::Raw::Bzip2> has been upgraded from version 2.05201 to 2.055.  The
 misuse of Perl's "magic" API has been fixed.