Upgrade to CGI.pm-3.48
authorSteve Hay <SteveHay@planit.com>
Sat, 10 Oct 2009 11:05:09 +0000 (12:05 +0100)
committerSteve Hay <SteveHay@planit.com>
Sun, 11 Oct 2009 02:11:59 +0000 (03:11 +0100)
44 files changed:
MANIFEST
Porting/Maintainers.pl
cpan/CGI/Changes
cpan/CGI/examples/clickable_image.cgi
cpan/CGI/examples/frameset.cgi
cpan/CGI/examples/internal_links.cgi
cpan/CGI/examples/multiple_forms.cgi
cpan/CGI/examples/popup.cgi
cpan/CGI/lib/CGI.pm
cpan/CGI/lib/CGI/Carp.pm
cpan/CGI/lib/CGI/Cookie.pm
cpan/CGI/lib/CGI/Fast.pm
cpan/CGI/lib/CGI/Pretty.pm
cpan/CGI/lib/CGI/Util.pm
cpan/CGI/t/apache.t
cpan/CGI/t/autoescape.t [new file with mode: 0644]
cpan/CGI/t/can.t
cpan/CGI/t/carp.t
cpan/CGI/t/checkbox_group.t [new file with mode: 0644]
cpan/CGI/t/cookie.t
cpan/CGI/t/end_form.t [new file with mode: 0644]
cpan/CGI/t/fast.t
cpan/CGI/t/form.t
cpan/CGI/t/function.t
cpan/CGI/t/hidden.t [new file with mode: 0644]
cpan/CGI/t/html.t
cpan/CGI/t/http.t [new file with mode: 0644]
cpan/CGI/t/init.t [new file with mode: 0644]
cpan/CGI/t/init_test.txt [new file with mode: 0644]
cpan/CGI/t/no_tabindex.t
cpan/CGI/t/popup_menu.t
cpan/CGI/t/pretty.t
cpan/CGI/t/push.t
cpan/CGI/t/query_string.t
cpan/CGI/t/request.t
cpan/CGI/t/save_read_roundtrip.t [new file with mode: 0644]
cpan/CGI/t/switch.t
cpan/CGI/t/unescapeHTML.t
cpan/CGI/t/upload.t
cpan/CGI/t/uploadInfo.t
cpan/CGI/t/user_agent.t
cpan/CGI/t/utf8.t [new file with mode: 0644]
cpan/CGI/t/util-58.t
cpan/CGI/t/util.t

index 35e1072..679569f 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -195,20 +195,28 @@ cpan/CGI/lib/CGI/Push.pm          Support for server push
 cpan/CGI/lib/CGI/Switch.pm             Simple interface for multiple server types
 cpan/CGI/lib/CGI/Util.pm               Utility functions
 cpan/CGI/t/apache.t                    See if CGI::Apache still loads
+cpan/CGI/t/autoescape.t                        See if CGI.pm works
 cpan/CGI/t/can.t                       See if CGI.pm works
 cpan/CGI/t/carp.t                      See if CGI::Carp works
+cpan/CGI/t/checkbox_group.t            See if CGI.pm works
 cpan/CGI/t/cookie.t                    See if CGI::Cookie works
 cpan/CGI/t/Dump.t                      See if CGI->Dump works
+cpan/CGI/t/end_form.t                  See if CGI.pm works
 cpan/CGI/t/fast.t                      See if CGI::Fast works (if FCGI is installed)
 cpan/CGI/t/form.t                      See if CGI.pm works
 cpan/CGI/t/function.t                  See if CGI.pm works
+cpan/CGI/t/hidden.t                    See if CGI.pm works
 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/no_tabindex.t               See if CGI.pm works
 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
 cpan/CGI/t/query_string.t              See if CGI->query_string() works
 cpan/CGI/t/request.t                   See if CGI.pm works
+cpan/CGI/t/save_read_roundtrip.t       See if CGI.pm works
 cpan/CGI/t/start_end_asterisk.t                See if CGI.pm works
 cpan/CGI/t/start_end_end.t             See if CGI.pm works
 cpan/CGI/t/start_end_start.t           See if CGI.pm works
@@ -218,6 +226,7 @@ cpan/CGI/t/uploadInfo.t                     See if CGI.pm works
 cpan/CGI/t/upload_post_text.txt                Test data for CGI.pm
 cpan/CGI/t/upload.t                    See if CGI.pm works
 cpan/CGI/t/user_agent.t                        See if CGI->user_agent() works
+cpan/CGI/t/utf8.t                      See if CGI.pm works
 cpan/CGI/t/util-58.t                   See if 5.8-dependent features work
 cpan/CGI/t/util.t                      See if CGI.pm works
 cpan/Class-ISA/ChangeLog               Changes for Class::ISA
index e4c3205..6707022 100755 (executable)
@@ -300,7 +300,7 @@ use File::Glob qw(:case);
     'CGI' =>
        {
        'MAINTAINER'    => 'lstein',
-       'DISTRIBUTION'  => 'LDS/CGI.pm-3.45.tar.gz',
+       'DISTRIBUTION'  => 'LDS/CGI.pm-3.48.tar.gz',
        'FILES'         => q[cpan/CGI],
        'EXCLUDED'      => [ qr{^t/lib/Test},
                                qw( cgi-lib_porting.html
@@ -310,7 +310,7 @@ use File::Glob qw(:case);
                                )
                           ],
        'CPAN'          => 1,
-       'UPSTREAM'      => undef,
+       'UPSTREAM'      => 'cpan',
        },
 
     'Class::ISA' =>
index a45e39b..e7acabd 100644 (file)
@@ -1,16 +1,93 @@
+Version 3.48
+
+  [BUG FIXES]
+  1. <optgroup> default values are now properly escaped.
+     Thanks to #raleigh.pm and Mark Stosberg. (RT#49606)
+  2. The change to exception handling in CGI::Carp introduced in 3.47 has been
+     reverted for now. It caused regressions reported in RT#49630. 
+     Thanks to mkanat for the report.
+
+  [DOCUMENTATION]
+  1. Documentation for upload() has been overhauled, thanks to Mark Stosberg. 
+  2. Documentation for tmpFileName has been added. Thanks to Mark Stosberg and Nathaniel K. Smith.
+  3. URLS were updated, thanks to Leon Brocard and Yanick Champoux. (RT#49770)
+
+  [INTERNALS]
+  1. More tests were added for autoescape, thanks to Bob Kuo. (RT#25485)
+
+Version 3.47
+  Released September 9th, 2009.
+  No code changes. 
+
+  [INTERNALS]
+    Re-release of 3.46, which did not contain a proper MANIFEST
+
+Version 3.46
+  [BUG FIXES]
+  1. In CGI::Pretty, we no longer add line breaks after tags we claim not to format. Thanks to rrt, Bob Kuo and
+     and Mark Stosberg. (RT#42114).
+  2. unescapeHTML() no longer falsely recognizes certain text as entities. Thanks to Pete Gamanche, Mark Stosberg
+     and Bob Kuo. (RT#39122)
+  3. checkbox_group() now correctly includes a space before the "checked" attribute.
+     Thanks to Andrew Speer and Bob Kuo. (RT#36583)
+  4. Fix case-sensitivity in http() and https() according to docs. Make https()
+     return list of keys in list context. Thanks to riQyRoe and Rhesa Rozendaal. (RT#12909)
+  5. XHTML is now automatically disabled for HTML 4, as well as HTML 2 and HTML 3. Thanks to
+     Dan Harkless and Yanick Champoux. (RT#27907)
+  6. Pre-compiling 'end_form' with ':form' switch now works. Thanks to ryochin and Yanick Champoux. (RT#41530)
+  7. Empty name/values pairs are now properly saved and restored from filehandles. Thanks to rlucas and
+     Rhesa Rozendaal (RT#13158)
+  8. Some differences between startform() and start_form() have been fixed. Thanks to Slaven Rezic and
+     Shawn Corey. (RT#22046)
+  9. url_param() has been updated to be more consistent with the documentation and param().
+     Thanks to Britton Kerin and Yanick Campoux. (RT#43587)
+  10.hidden() now correctly supports multiple default values.
+     Thanks to david@dierauer.net and Russell Jenkins. (RT#20436)
+  11.Calling CGI->new() no longer clobbers the value of $_ in the current scope.
+     Thanks to Alexey Tourbin, Bob Kuo and Mark Stosberg. (RT#25131)
+  12.UTF-8 params should not get double-decoded now.
+     Thanks to Yves, Bodo, Burak G�rsoy, and Michael Schout. (RT#19913)
+  13.We now give objects passed to CGI::Carp::die a chance to be stringified.
+     Thanks to teek and Yanick Champoux (RT#41530)
+  14.Turning off autoEscape() now only affects the behavior of built-in HTML
+     generation fuctions. Explicit calls to escapeHTML() always escape HTML regardless
+     of the setting. Thanks to vindex, Bob Kuo and Mark Stosberg (RT#40748)
+  15.In CGI::Fast, preferences set via pragmas are now preserved.
+     Thanks to heinst and Mark Stosberg (RT#32119)
+
+  [DOCUMENTATION]
+  1. remote_addr() is now documented. Thanks to Yanick Champoux. (RT#38884)
+  2. In CGI::Pretty in the list of tags left unformatted was updated to match the code. Thanks to Mark Stosberg. (RT#42114)
+  3. In CGI::Pretty, performance concerns are now documented. Thanks to Jochen, Rhesa Rozendaal and Mark Stosberg (RT#13223)
+  4. A number of outdated Netscape references have been removed. Thanks to Mark Stosberg.
+  5. The documentation has been purged of examples of using indirect object notation. Thanks to Mark Stosberg.
+  6. Some POD formatting was fixed. Thanks to Dave Mitchell (RT#48935).
+  7. Docs and examples were updated to highlight start_form instead of startform.
+     Thanks to Slaven Rezic.
+  8. Note that CGI::Carp::carpout() doesn't work with in-memory filehandles. 
+     Thanks to rhubbell and Mark Stosberg. 
+  9. The documentation for the -newstyle_urls is now less confusing.
+     Thanks to Ryan Tate and Mark Stosberg (RT#49454)
+
+  [INTERNALS]
+  1. Quit bundling an ancient copy of Test::More and and using a custom 'lib' path for the tests. Instead, Test::More
+     is now a dependency. Thanks to Ansgar and Mark Stosberg (RT#48811)
+  2. Automated tests for hidden() have been added, thanks to Russel Jenkins and Mark Stosberg (RT#20436)
+  3. t/util.t has been updated to use Test::More instead of a home-grown test function. Thanks to Bob Kuo.
+
 Version 3.45
   [BUG FIXES]
   1. Prevent warnings about "uninitialized values" for REQUEST_URI, HTTP_USER_AGENT and other environment variables.
      Patches by Callum Gibson, heiko and Mark Stosberg. (RT#24684, RT#29065)
-  2. Avoid death in some cases when running under Taint mode on Windows. 
+  2. Avoid death in some cases when running under Taint mode on Windows.
      Patch by Peter Hancock (RT#43796)
   3. Allow 0 to be used as a default value in popup_menu(). This was broken starting in 3.37.
      Thanks to Haze, who was the first to report this and supply a patch, and pfschill, who pinpointed
      when the bug was introduced. A regression test for this was also added. (RT#37908)
-  4. Allow "+" as a valid character in file names, which fixes temp file creation on OS X Leopard.  
-     Thanks to Andy Armstrong, and alech for patches. (RT#30504) 
+  4. Allow "+" as a valid character in file names, which fixes temp file creation on OS X Leopard.
+     Thanks to Andy Armstrong, and alech for patches. (RT#30504)
   5. Set binmode() on the Netware platform, thanks to Guenter Knauf (RT#27455)
-  6. Don't allow a CGI::Carp error handler to die recursively. Print a warning and exit instead. 
+  6. Don't allow a CGI::Carp error handler to die recursively. Print a warning and exit instead.
      Thanks to Marc Chantreux. (RT#45956)
   7. The Dump() method now is fixed to escape HTML properly. Thanks to Mark Stosberg (RT#21341)
   8. Support for <optgroup> with scrolling_list() now works the same way as it does for popup_menu().
@@ -27,20 +104,20 @@ Version 3.45
   5. The docs for redirect() were updated to reflect that most headers are
      ignored during redirection. Thanks to Mark Stosberg (RT#44911)
 
-  [INTERNALS]  
+  [INTERNALS]
   1. New t/unescapeHTML.t test script has been added. It includes a TODO test for a pre-existing
      bug which could use a patch. Thanks to Pete Gamache and Mark Stosberg (RT#39122)
   2. New test scripts have been added for user_agent(), popup_menu() and query_string(), scrolling_list() and Dump()
      Thanks to Mark Stosberg and Stuart Johnston. (RT#37908, RT#43006, RT#21341, RT#30097)
-  3. CGI::Carp and CGI::Util have been updated to have non-developer version numbers. 
+  3. CGI::Carp and CGI::Util have been updated to have non-developer version numbers.
      Thanks to Slaven Rezic. (RT#48425)
-  4. CGI::Switch and CGI::Apache now properly set their VERSION in their own name space.  
+  4. CGI::Switch and CGI::Apache now properly set their VERSION in their own name space.
      Thanks to Alexey Tourbin (RT#11941,RT#11942)
 
   Version 3.44
   1. Patch from Kurt Jaeger to allow HTTP PUT even if the content length is unknown.
   2. Patch from Pavel merdin to fix a problem for one of the FireFox addons.
-  3. Fixed issue in mod_perl & fastCGI environment of cookies returned from 
+  3. Fixed issue in mod_perl & fastCGI environment of cookies returned from
      CGI->cookie() leaking from one session to another.
 
   Version 3.43
@@ -210,7 +287,7 @@ Version 3.45
 
   Version 3.14 Tue Dec  6 17:12:03 EST 2005
    1. Fixed broken scrolling_list() select attribute.
-       
+
   Version 3.13
     1. Removed extraneous empty "?" from end of self_url().
 
@@ -234,7 +311,7 @@ Version 3.45
   Version 3.11
     1. Killed warning in CGI::Cookie about MOD_PERL_API_VERSION
     2. Fixed append() so that it works in function mode.
-    3. Workaround for a bug that appears in Apache2 versions through 2.0.54 
+    3. Workaround for a bug that appears in Apache2 versions through 2.0.54
        in which SCRIPT_NAME and PATH_INFO are incorrect if the additional path_info
        contains a double slash. This workaround will handle the common case of
        http://mysite.com/cgi-bin/log.cgi/http://www.some.other.site/args, but will
@@ -268,7 +345,7 @@ Version 3.45
     5. Tests for *tag start/end generation from Shlomi Fish.
     6. Support for can() method provided by Ron Savage.
     7. Fix for lang='' when outputting XHTML.
-    8. Added support for chunked transfer encoding, as suggested by 
+    8. Added support for chunked transfer encoding, as suggested by
        Hakan Ardo
     9. Fixed clobbering of row and column headers in tableized radio
        and checkbox groups, as reported by Nicolas Thierry-Mieg.
@@ -1109,7 +1186,7 @@ Version 3.45
     4. HTML shortcuts now generate tags in ALL UPPERCASE.
     5. start_html() now generates correct SGML header:
       <!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML//EN">
-      
+
     6. CGI::Carp no longer fails "use strict refs" pragma.
 
   Version 2.25
index 81daf09..0f6f672 100644 (file)
@@ -10,7 +10,7 @@ print <<END;
 END
 print "Sorry, this isn't very exciting!\n";
 
-print $query->startform;
+print $query->start_form;
 print $query->image_button('picture',"./wilogo.gif");
 print "Give me a: ",$query->popup_menu('letter',['A','B','C','D','E','W']),"\n"; # 
 print "<P>Magnification: ",$query->radio_group('magnification',['1X','2X','4X','20X']),"\n";
index fc86e92..77a748b 100644 (file)
@@ -54,7 +54,7 @@ sub print_end {
 sub print_query {
     $script_name = $query->script_name;
     print "<H1>Frameset Query</H1>\n";
-    print $query->startform(-action=>"$script_name/response",-TARGET=>"response");
+    print $query->start_form(-action=>"$script_name/response",-TARGET=>"response");
     print "What's your name? ",$query->textfield('name');
     print "<P>What's the combination?<P>",
     $query->checkbox_group(-name=>'words',
index 4806966..c61722c 100644 (file)
@@ -17,7 +17,7 @@ print "<A NAME=\"start\"></A>\n"; # an anchor point at the top
 # pick a default starting value;
 $query->param('amenu','FOO1') unless $query->param('amenu');
 
-print $query->startform;
+print $query->start_form;
 print $query->popup_menu('amenu',[('FOO1'..'FOO9')]);
 print $query->submit,$query->endform;
 
index b38bf93..a17a125 100644 (file)
@@ -8,7 +8,7 @@ print $query->start_html('Multiple Forms');
 print "<H1>Multiple Forms</H1>\n";
 
 # Print the first form
-print $query->startform;
+print $query->start_form;
 $name = $query->remote_user || 'anonymous@' . $query->remote_host;
 
 print "What's your name? ",$query->textfield('name',$name,50);
@@ -22,7 +22,7 @@ print $query->endform;
 
 # Print the second form
 print "<HR>\n";
-print $query->startform;
+print $query->start_form;
 print "Some radio buttons: ",$query->radio_group('radio buttons',
                                                 [qw{one two three four five}],'three'),"\n";
 print "<P>What's the password? ",$query->password_field('pass','secret');
index 88cea1d..35cab57 100644 (file)
@@ -8,7 +8,7 @@ print $query->start_html('Popup Window');
 
 if (!$query->param) {
     print "<H1>Ask your Question</H1>\n";
-    print $query->startform(-target=>'_new');
+    print $query->start_form(-target=>'_new');
     print "What's your name? ",$query->textfield('name');
     print "<P>What's the combination?<P>",
     $query->checkbox_group(-name=>'words',
index cacb03a..0cba881 100644 (file)
@@ -19,7 +19,7 @@ use Carp 'croak';
 #   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.45';
+$CGI::VERSION='3.48';
 
 # HARD-CODED LOCATION FOR FILE UPLOAD TEMPORARY FILES.
 # UNCOMMENT THIS ONLY IF YOU KNOW WHAT YOU'RE DOING.
@@ -128,7 +128,9 @@ sub initialize_globals {
 
 # ------------------ START OF THE LIBRARY ------------
 
-*end_form = \&endform;
+#### Method: endform
+# This method is DEPRECATED
+*endform = \&end_form;
 
 # make mod_perlhappy
 initialize_globals();
@@ -455,12 +457,23 @@ sub param {
 
     if ($PARAM_UTF8) {
       eval "require Encode; 1;" unless Encode->can('decode'); # bring in these functions
-      @result = map {ref $_ ? $_ : Encode::decode(utf8=>$_) } @result;
+      @result = map {ref $_ ? $_ : $self->_decode_utf8($_) } @result;
     }
 
     return wantarray ?  @result : $result[0];
 }
 
+sub _decode_utf8 {
+    my ($self, $val) = @_;
+
+    if (Encode::is_utf8($val)) {
+        return $val;
+    }
+    else {
+        return Encode::decode(utf8 => $val);
+    }
+}
+
 sub self_or_default {
     return @_ if defined($_[0]) && (!ref($_[0])) &&($_[0] eq 'CGI');
     unless (defined($_[0]) && 
@@ -613,10 +626,10 @@ sub init {
          }
 
           if (defined($fh) && ($fh ne '')) {
-              while (<$fh>) {
-                  chomp;
-                  last if /^=/;
-                  push(@lines,$_);
+              while (my $line = <$fh>) {
+                  chomp $line;
+                  last if $line =~ /^=$/;
+                  push(@lines,$line);
               }
               # massage back into standard format
               if ("@lines" =~ /=/) {
@@ -1337,7 +1350,8 @@ sub url_param {
                push(@{$self->{'.url_param'}->{$param}},$value);
            }
        } else {
-           $self->{'.url_param'}->{'keywords'} = [$self->parse_keywordlist($ENV{QUERY_STRING})];
+        my @keywords = $self->parse_keywordlist($ENV{QUERY_STRING});
+           $self->{'.url_param'}{'keywords'} = \@keywords if @keywords;
        }
     }
     return keys %{$self->{'.url_param'}} unless defined($name);
@@ -1359,11 +1373,11 @@ sub Dump {
     return '<ul></ul>' unless $self->param;
     push(@result,"<ul>");
     for $param ($self->param) {
-       my($name)=$self->escapeHTML($param);
+       my($name)=$self->_maybe_escapeHTML($param);
        push(@result,"<li><strong>$name</strong></li>");
        push(@result,"<ul>");
        for $value ($self->param($param)) {
-           $value = $self->escapeHTML($value);
+           $value = $self->_maybe_escapeHTML($value);
             $value =~ s/\n/<br \/>\n/g;
            push(@result,"<li>$value</li>");
        }
@@ -1399,7 +1413,8 @@ sub save {
        my($escaped_param) = escape($param);
        my($value);
        for $value ($self->param($param)) {
-           print $filehandle "$escaped_param=",escape("$value"),"\n";
+           print $filehandle "$escaped_param=",escape("$value"),"\n"
+               if length($escaped_param) or length($value);
        }
     }
     for (keys %{$self->{'.fieldnames'}}) {
@@ -1692,10 +1707,10 @@ sub start_html {
     # Now that we know whether we're using the HTML 3.2 DTD or not, it's okay to
     # call escapeHTML().  Strangely enough, the title needs to be escaped as
     # HTML while the author needs to be escaped as a URL.
-    $title = $self->escapeHTML($title || 'Untitled Document');
+    $title = $self->_maybe_escapeHTML($title || 'Untitled Document');
     $author = $self->escape($author);
 
-    if ($DTD_PUBLIC_IDENTIFIER =~ /[^X]HTML (2\.0|3\.2)/i) {
+    if ($DTD_PUBLIC_IDENTIFIER =~ /[^X]HTML (2\.0|3\.2|4\.01?)/i) {
        $lang = "" unless defined $lang;
        $XHTML = 0;
     }
@@ -1893,6 +1908,7 @@ END_OF_FUNC
 
 
 #### Method: startform
+# This method is DEPRECATED
 # Start a form
 # Parameters:
 #   $method -> optional submission method to use (GET or POST)
@@ -1905,13 +1921,13 @@ sub startform {
     my($method,$action,$enctype,@other) = 
        rearrange([METHOD,ACTION,ENCTYPE],@p);
 
-    $method  = $self->escapeHTML(lc($method || 'post'));
-    $enctype = $self->escapeHTML($enctype || &URL_ENCODED);
+    $method  = $self->_maybe_escapeHTML(lc($method || 'post'));
+    $enctype = $self->_maybe_escapeHTML($enctype || &URL_ENCODED);
     if (defined $action) {
-       $action = $self->escapeHTML($action);
+       $action = $self->_maybe_escapeHTML($action);
     }
     else {
-       $action = $self->escapeHTML($self->request_uri || $self->self_url);
+       $action = $self->_maybe_escapeHTML($self->request_uri || $self->self_url);
     }
     $action = qq(action="$action");
     my($other) = @other ? " @other" : '';
@@ -1920,55 +1936,82 @@ sub startform {
 }
 END_OF_FUNC
 
-
 #### Method: start_form
-# synonym for startform
+# Start a form
+# Parameters:
+#   $method -> optional submission method to use (GET or POST)
+#   $action -> optional URL of script to run
+#   $enctype ->encoding to use (URL_ENCODED or MULTIPART)
 'start_form' => <<'END_OF_FUNC',
 sub start_form {
-    $XHTML ? &start_multipart_form : &startform;
-}
-END_OF_FUNC
+    my($self,@p) = self_or_default(@_);
 
-'end_multipart_form' => <<'END_OF_FUNC',
-sub end_multipart_form {
-    &endform;
+    my($method,$action,$enctype,@other) = 
+       rearrange([METHOD,ACTION,ENCTYPE],@p);
+
+    $method  = $self->_maybe_escapeHTML(lc($method || 'post'));
+
+    if( $XHTML ){
+        $enctype = $self->_maybe_escapeHTML($enctype || &MULTIPART);
+    }else{
+        $enctype = $self->_maybe_escapeHTML($enctype || &URL_ENCODED);
+    }
+
+    if (defined $action) {
+       $action = $self->_maybe_escapeHTML($action);
+    }
+    else {
+       $action = $self->_maybe_escapeHTML($self->request_uri || $self->self_url);
+    }
+    $action = qq(action="$action");
+    my($other) = @other ? " @other" : '';
+    $self->{'.parametersToAdd'}={};
+    return qq/<form method="$method" $action enctype="$enctype"$other>\n/;
 }
 END_OF_FUNC
 
 #### Method: start_multipart_form
-# synonym for startform
 'start_multipart_form' => <<'END_OF_FUNC',
 sub start_multipart_form {
     my($self,@p) = self_or_default(@_);
     if (defined($p[0]) && substr($p[0],0,1) eq '-') {
-      return $self->startform(-enctype=>&MULTIPART,@p);
+      return $self->start_form(-enctype=>&MULTIPART,@p);
     } else {
        my($method,$action,@other) = 
            rearrange([METHOD,ACTION],@p);
-       return $self->startform($method,$action,&MULTIPART,@other);
+       return $self->start_form($method,$action,&MULTIPART,@other);
     }
 }
 END_OF_FUNC
 
 
-#### Method: endform
+
+#### Method: end_form
 # End a form
-'endform' => <<'END_OF_FUNC',
-sub endform {
+'end_form' => <<'END_OF_FUNC',
+sub end_form {
     my($self,@p) = self_or_default(@_);
     if ( $NOSTICKY ) {
-    return wantarray ? ("</form>") : "\n</form>";
+        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>";
-      }
+        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',
+sub end_multipart_form {
+    &end_form;
+}
+END_OF_FUNC
+
 
 '_textfield' => <<'END_OF_FUNC',
 sub _textfield {
@@ -1979,8 +2022,8 @@ sub _textfield {
     my $current = $override ? $default : 
        (defined($self->param($name)) ? $self->param($name) : $default);
 
-    $current = defined($current) ? $self->escapeHTML($current,1) : '';
-    $name = defined($name) ? $self->escapeHTML($name) : '';
+    $current = defined($current) ? $self->_maybe_escapeHTML($current,1) : '';
+    $name = defined($name) ? $self->_maybe_escapeHTML($name) : '';
     my($s) = defined($size) ? qq/ size="$size"/ : '';
     my($m) = defined($maxlength) ? qq/ maxlength="$maxlength"/ : '';
     my($other) = @other ? " @other" : '';
@@ -2064,8 +2107,8 @@ sub textarea {
     my($current)= $override ? $default :
        (defined($self->param($name)) ? $self->param($name) : $default);
 
-    $name = defined($name) ? $self->escapeHTML($name) : '';
-    $current = defined($current) ? $self->escapeHTML($current) : '';
+    $name = defined($name) ? $self->_maybe_escapeHTML($name) : '';
+    $current = defined($current) ? $self->_maybe_escapeHTML($current) : '';
     my($r) = $rows ? qq/ rows="$rows"/ : '';
     my($c) = $cols ? qq/ cols="$cols"/ : '';
     my($other) = @other ? " @other" : '';
@@ -2092,9 +2135,11 @@ sub button {
     my($label,$value,$script,$tabindex,@other) = rearrange([NAME,[VALUE,LABEL],
                                                            [ONCLICK,SCRIPT],TABINDEX],@p);
 
-    $label=$self->escapeHTML($label);
-    $value=$self->escapeHTML($value,1);
-    $script=$self->escapeHTML($script);
+    $label=$self->_maybe_escapeHTML($label);
+    $value=$self->_maybe_escapeHTML($value,1);
+    $script=$self->_maybe_escapeHTML($script);
+
+    $script ||= '';
 
     my($name) = '';
     $name = qq/ name="$label"/ if $label;
@@ -2125,8 +2170,8 @@ sub submit {
 
     my($label,$value,$tabindex,@other) = rearrange([NAME,[VALUE,LABEL],TABINDEX],@p);
 
-    $label=$self->escapeHTML($label);
-    $value=$self->escapeHTML($value,1);
+    $label=$self->_maybe_escapeHTML($label);
+    $value=$self->_maybe_escapeHTML($value,1);
 
     my $name = $NOSTICKY ? '' : 'name=".submit" ';
     $name = qq/name="$label" / if defined($label);
@@ -2152,8 +2197,8 @@ END_OF_FUNC
 sub reset {
     my($self,@p) = self_or_default(@_);
     my($label,$value,$tabindex,@other) = rearrange(['NAME',['VALUE','LABEL'],TABINDEX],@p);
-    $label=$self->escapeHTML($label);
-    $value=$self->escapeHTML($value,1);
+    $label=$self->_maybe_escapeHTML($label);
+    $value=$self->_maybe_escapeHTML($value,1);
     my ($name) = ' name=".reset"';
     $name = qq/ name="$label"/ if defined($label);
     $value = defined($value) ? $value : $label;
@@ -2184,7 +2229,7 @@ sub defaults {
 
     my($label,$tabindex,@other) = rearrange([[NAME,VALUE],TABINDEX],@p);
 
-    $label=$self->escapeHTML($label,1);
+    $label=$self->_maybe_escapeHTML($label,1);
     $label = $label || "Defaults";
     my($value) = qq/ value="$label"/;
     my($other) = @other ? " @other" : '';
@@ -2234,9 +2279,9 @@ sub checkbox {
        $checked = $self->_checked($checked);
     }
     my($the_label) = defined $label ? $label : $name;
-    $name = $self->escapeHTML($name);
-    $value = $self->escapeHTML($value,1);
-    $the_label = $self->escapeHTML($the_label);
+    $name = $self->_maybe_escapeHTML($name);
+    $value = $self->_maybe_escapeHTML($value,1);
+    $the_label = $self->_maybe_escapeHTML($the_label);
     my($other) = @other ? "@other " : '';
     $tabindex = $self->element_tab($tabindex);
     $self->register_parameter($name);
@@ -2248,40 +2293,39 @@ END_OF_FUNC
 
 
 
-# Escape HTML -- used internally
+# Escape HTML
 'escapeHTML' => <<'END_OF_FUNC',
 sub escapeHTML {
-         # hack to work around  earlier hacks
-         push @_,$_[0] if @_==1 && $_[0] eq 'CGI';
-         my ($self,$toencode,$newlinestoo) = CGI::self_or_default(@_);
-         return undef unless defined($toencode);
-         return $toencode if ref($self) && !$self->{'escape'};
-         $toencode =~ s{&}{&amp;}gso;
-         $toencode =~ s{<}{&lt;}gso;
-         $toencode =~ s{>}{&gt;}gso;
-        if ($DTD_PUBLIC_IDENTIFIER =~ /[^X]HTML 3\.2/i) {
-            # $quot; was accidentally omitted from the HTML 3.2 DTD -- see
-            # <http://validator.w3.org/docs/errors.html#bad-entity> /
-            # <http://lists.w3.org/Archives/Public/www-html/1997Mar/0003.html>.
-            $toencode =~ s{"}{&#34;}gso;
-         }
-         else {
-            $toencode =~ s{"}{&quot;}gso;
-         }
-         # Handle bug in some browsers with Latin charsets
-         if ($self->{'.charset'} &&
-             (uc($self->{'.charset'}) eq 'ISO-8859-1' ||
-              uc($self->{'.charset'}) eq 'WINDOWS-1252'))
-         {
+     # hack to work around  earlier hacks
+     push @_,$_[0] if @_==1 && $_[0] eq 'CGI';
+     my ($self,$toencode,$newlinestoo) = CGI::self_or_default(@_);
+     return undef unless defined($toencode);
+     $toencode =~ s{&}{&amp;}gso;
+     $toencode =~ s{<}{&lt;}gso;
+     $toencode =~ s{>}{&gt;}gso;
+     if ($DTD_PUBLIC_IDENTIFIER =~ /[^X]HTML 3\.2/i) {
+     # $quot; was accidentally omitted from the HTML 3.2 DTD -- see
+     # <http://validator.w3.org/docs/errors.html#bad-entity> /
+     # <http://lists.w3.org/Archives/Public/www-html/1997Mar/0003.html>.
+        $toencode =~ s{"}{&#34;}gso;
+     }
+     else {
+        $toencode =~ s{"}{&quot;}gso;
+     }
+
+    # Handle bug in some browsers with Latin charsets
+    if ($self->{'.charset'} 
+            && (uc($self->{'.charset'}) eq 'ISO-8859-1' 
+            || uc($self->{'.charset'}) eq 'WINDOWS-1252')) {
                 $toencode =~ s{'}{&#39;}gso;
                 $toencode =~ s{\x8b}{&#8249;}gso;
                 $toencode =~ s{\x9b}{&#8250;}gso;
-                if (defined $newlinestoo && $newlinestoo) {
-                     $toencode =~ s{\012}{&#10;}gso;
-                     $toencode =~ s{\015}{&#13;}gso;
-                }
-         }
-         return $toencode;
+        if (defined $newlinestoo && $newlinestoo) {
+            $toencode =~ s{\012}{&#10;}gso;
+            $toencode =~ s{\015}{&#13;}gso;
+        }
+    }
+    return $toencode;
 }
 END_OF_FUNC
 
@@ -2295,7 +2339,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[&(.*?);]{
+    $string=~ s[&(\S*?);]{
        local $_ = $1;
        /^amp$/i        ? "&" :
        /^quot$/i       ? '"' :
@@ -2422,7 +2466,7 @@ sub _box_group {
     # If no check array is specified, check the first by default
     $checked{$values[0]}++ if $box_type eq 'radio' && !%checked;
 
-    $name=$self->escapeHTML($name);
+    $name=$self->_maybe_escapeHTML($name);
 
     my %tabs = ();
     if ($TABINDEX && $tabindex) {
@@ -2463,19 +2507,19 @@ sub _box_group {
        unless (defined($nolabels) && $nolabels) {
            $label = $_;
            $label = $labels->{$_} if defined($labels) && defined($labels->{$_});
-           $label = $self->escapeHTML($label,1);
+           $label = $self->_maybe_escapeHTML($label,1);
             $label = "<span style=\"color:gray\">$label</span>" if $disabled{$_};
        }
         my $attribs = $self->_set_attributes($_, $attributes);
         my $tab     = $tabs{$_};
-       $_=$self->escapeHTML($_);
+       $_=$self->_maybe_escapeHTML($_);
 
         if ($XHTML) {
            push @elements,
               CGI::label($labelattributes,
                    qq(<input type="$box_type" name="$name" value="$_" $checkit$other$tab$attribs$disable/>$label)).${break};
         } else {
-            push(@elements,qq/<input type="$box_type" name="$name" value="$_"$checkit$other$tab$attribs$disable>${label}${break}/);
+            push(@elements,qq/<input type="$box_type" name="$name" value="$_" $checkit$other$tab$attribs$disable>${label}${break}/);
         }
     }
     $self->register_parameter($name);
@@ -2516,7 +2560,7 @@ sub popup_menu {
                                 ? @$default 
                                 : $default;
     }
-    $name=$self->escapeHTML($name);
+    $name=$self->_maybe_escapeHTML($name);
     my($other) = @other ? " @other" : '';
 
     my(@values);
@@ -2528,7 +2572,7 @@ sub popup_menu {
             for my $v (split(/\n/)) {
                 my $selectit = $XHTML ? 'selected="selected"' : 'selected';
                for my $selected (keys %selected) {
-                   $v =~ s/(value="$selected")/$selectit $1/;
+                   $v =~ s/(value="\Q$selected\E")/$selectit $1/;
                }
                 $result .= "$v\n";
             }
@@ -2538,8 +2582,8 @@ sub popup_menu {
          my($selectit) = $self->_selected($selected{$_});
          my($label)    = $_;
          $label        = $labels->{$_} if defined($labels) && defined($labels->{$_});
-         my($value)    = $self->escapeHTML($_);
-         $label        = $self->escapeHTML($label,1);
+         my($value)    = $self->_maybe_escapeHTML($_);
+         $label        = $self->_maybe_escapeHTML($label,1);
           $result      .= "<option${attribs} ${selectit}value=\"$value\">$label</option>\n";
         }
     }
@@ -2582,7 +2626,7 @@ sub optgroup {
     @values = $self->_set_values_and_labels($values,\$labels,$name,$labeled,$novals);
     my($other) = @other ? " @other" : '';
 
-    $name=$self->escapeHTML($name);
+    $name=$self->_maybe_escapeHTML($name);
     $result = qq/<optgroup label="$name"$other>\n/;
     for (@values) {
         if (/<optgroup/) {
@@ -2596,8 +2640,8 @@ sub optgroup {
             my $attribs = $self->_set_attributes($_, $attributes);
             my($label) = $_;
             $label = $labels->{$_} if defined($labels) && defined($labels->{$_});
-            $label=$self->escapeHTML($label);
-            my($value)=$self->escapeHTML($_,1);
+            $label=$self->_maybe_escapeHTML($label);
+            my($value)=$self->_maybe_escapeHTML($_,1);
             $result .= $labeled ? $novals ? "<option$attribs label=\"$value\">$label</option>\n"
                                           : "<option$attribs label=\"$value\" value=\"$value\">$label</option>\n"
                                 : $novals ? "<option$attribs>$label</option>\n"
@@ -2648,7 +2692,7 @@ sub scrolling_list {
     my($has_size) = $size ? qq/ size="$size"/: '';
     my($other) = @other ? " @other" : '';
 
-    $name=$self->escapeHTML($name);
+    $name=$self->_maybe_escapeHTML($name);
     $tabindex = $self->element_tab($tabindex);
     $result = qq/<select name="$name" $tabindex$has_size$is_multiple$other>\n/;
     for (@values) {
@@ -2666,8 +2710,8 @@ sub scrolling_list {
          my($selectit) = $self->_selected($selected{$_});
          my($label)    = $_;
          $label        = $labels->{$_} if defined($labels) && defined($labels->{$_});
-         my($value)    = $self->escapeHTML($_);
-         $label        = $self->escapeHTML($label,1);
+         my($value)    = $self->_maybe_escapeHTML($_);
+         $label        = $self->_maybe_escapeHTML($label,1);
           $result      .= "<option${attribs} ${selectit}value=\"$value\">$label</option>\n";
         }
     }
@@ -2706,15 +2750,16 @@ sub hidden {
        for ($default,$override,@other) {
            push(@value,$_) if defined($_);
        }
+        undef @other;
     }
 
     # use previous values if override is not set
     my @prev = $self->param($name);
     @value = @prev if !$do_override && @prev;
 
-    $name=$self->escapeHTML($name);
+    $name=$self->_maybe_escapeHTML($name);
     for (@value) {
-       $_ = defined($_) ? $self->escapeHTML($_,1) : '';
+       $_ = defined($_) ? $self->_maybe_escapeHTML($_,1) : '';
        push @result,$XHTML ? qq(<input type="hidden" name="$name" value="$_" @other />)
                             : qq(<input type="hidden" name="$name" value="$_" @other>);
     }
@@ -2740,7 +2785,7 @@ sub image_button {
 
     my($align) = $alignment ? " align=\L\"$alignment\"" : '';
     my($other) = @other ? " @other" : '';
-    $name=$self->escapeHTML($name);
+    $name=$self->_maybe_escapeHTML($name);
     return $XHTML ? qq(<input type="image" name="$name" src="$src"$align$other />)
                   : qq/<input type="image" name="$name" src="$src"$align$other>/;
 }
@@ -2872,7 +2917,7 @@ sub cookie {
     push(@param,'-secure'=>$secure) if $secure;
     push(@param,'-httponly'=>$httponly) if $httponly;
 
-    return new CGI::Cookie(@param);
+    return CGI::Cookie->new(@param);
 }
 END_OF_FUNC
 
@@ -3258,36 +3303,34 @@ END_OF_FUNC
 sub http {
     my ($self,$parameter) = self_or_CGI(@_);
     if ( defined($parameter) ) {
-       if ( $parameter =~ /^HTTP/ ) {
-           return $ENV{$parameter};
-       }
-       $parameter =~ tr/-/_/;
-    }
-    return $ENV{"HTTP_\U$parameter\E"} if $parameter;
-    my(@p);
-    for (keys %ENV) {
-       push(@p,$_) if /^HTTP/;
+        $parameter =~ tr/-a-z/_A-Z/;
+        if ( $parameter =~ /^HTTP(?:_|$)/ ) {
+            return $ENV{$parameter};
+        }
+        return $ENV{"HTTP_$parameter"};
     }
-    return @p;
+    return grep { /^HTTP(?:_|$)/ } keys %ENV;
 }
 END_OF_FUNC
 
 #### Method: https
-# Return the value of HTTPS
+# Return the value of HTTPS, or
+# the value of an HTTPS variable, or
+# the list of variables
 ####
 'https' => <<'END_OF_FUNC',
 sub https {
-    local($^W)=0;
     my ($self,$parameter) = self_or_CGI(@_);
-    return $ENV{HTTPS} unless $parameter;
-    return $ENV{$parameter} if $parameter=~/^HTTPS/;
-    $parameter =~ tr/-/_/;
-    return $ENV{"HTTPS_\U$parameter\E"} if $parameter;
-    my(@p);
-    for (keys %ENV) {
-       push(@p,$_) if /^HTTPS/;
+    if ( defined($parameter) ) {
+        $parameter =~ tr/-a-z/_A-Z/;
+        if ( $parameter =~ /^HTTPS(?:_|$)/ ) {
+            return $ENV{$parameter};
+        }
+        return $ENV{"HTTPS_$parameter"};
     }
-    return @p;
+    return wantarray
+        ? grep { /^HTTPS(?:_|$)/ } keys %ENV
+        : $ENV{'HTTPS'};
 }
 END_OF_FUNC
 
@@ -3409,6 +3452,17 @@ sub default_dtd {
 END_OF_FUNC
 
 # -------------- really private subroutines -----------------
+'_maybe_escapeHTML' => <<'END_OF_FUNC',
+sub _maybe_escapeHTML {
+    # hack to work around  earlier hacks
+    push @_,$_[0] if @_==1 && $_[0] eq 'CGI';
+    my ($self,$toencode,$newlinestoo) = CGI::self_or_default(@_);
+    return undef unless defined($toencode);
+    return $toencode if ref($self) && !$self->{'escape'};
+    return $self->escapeHTML($toencode, $newlinestoo);
+}
+END_OF_FUNC
+
 'previous_or_default' => <<'END_OF_FUNC',
 sub previous_or_default {
     my($self,$name,$defaults,$override) = @_;
@@ -3551,7 +3605,7 @@ sub read_multipart {
          # choose a relatively unpredictable tmpfile sequence number
           my $seqno = unpack("%16C*",join('',localtime,grep {defined $_} values %ENV));
           for (my $cnt=10;$cnt>0;$cnt--) {
-           next unless $tmpfile = new CGITempFile($seqno);
+           next unless $tmpfile = CGITempFile->new($seqno);
            $tmp = $tmpfile->as_string;
            last if defined($filehandle = Fh->new($filename,$tmp,$PRIVATE_TEMPFILES));
             $seqno += int rand(100);
@@ -3663,7 +3717,7 @@ sub read_multipart_related {
          # choose a relatively unpredictable tmpfile sequence number
           my $seqno = unpack("%16C*",join('',localtime,grep {defined $_} values %ENV));
           for (my $cnt=10;$cnt>0;$cnt--) {
-           next unless $tmpfile = new CGITempFile($seqno);
+           next unless $tmpfile = CGITempFile->new($seqno);
            $tmp = $tmpfile->as_string;
            last if defined($filehandle = Fh->new($param,$tmp,$PRIVATE_TEMPFILES));
             $seqno += int rand(100);
@@ -4301,7 +4355,7 @@ a simple "Hello World" HTML page:
 
    #!/usr/local/bin/perl -w
    use CGI;                             # load CGI routines
-   $q = new CGI;                        # create new CGI object
+   $q = CGI->new;                        # create new CGI object
    print $q->header,                    # create the HTTP header
          $q->start_html('hello world'), # start the HTML
          $q->h1('hello world'),         # level 1 header
@@ -4440,7 +4494,7 @@ HTML "standards".
 
 =head2 CREATING A NEW QUERY OBJECT (OBJECT-ORIENTED STYLE):
 
-     $query = new CGI;
+     $query = CGI->new;
 
 This will parse the input (from both POST and GET methods) and store
 it into a perl5 object called $query. 
@@ -4450,7 +4504,7 @@ the beginning of the file.
 
 =head2 CREATING A NEW QUERY OBJECT FROM AN INPUT FILE
 
-     $query = new CGI(INPUTFILE);
+     $query = CGI->new(INPUTFILE);
 
 If you provide a file handle to the new() method, it will read
 parameters from the file (or STDIN, or whatever).  The file can be in
@@ -4463,7 +4517,7 @@ Perl purists will be pleased to know that this syntax accepts
 references to file handles, or even references to filehandle globs,
 which is the "official" way to pass a filehandle:
 
-    $query = new CGI(\*STDIN);
+    $query = CGI->new(\*STDIN);
 
 You can also initialize the CGI object with a FileHandle or IO::File
 object.
@@ -4480,29 +4534,29 @@ default CGI object from the indicated file handle.
 You can also initialize the query object from a hash
 reference:
 
-    $query = new CGI( {'dinosaur'=>'barney',
+    $query = CGI->new( {'dinosaur'=>'barney',
                       'song'=>'I love you',
                       'friends'=>[qw/Jessica George Nancy/]}
                    );
 
 or from a properly formatted, URL-escaped query string:
 
-    $query = new CGI('dinosaur=barney&color=purple');
+    $query = CGI->new('dinosaur=barney&color=purple');
 
 or from a previously existing CGI object (currently this clones the
 parameter list, but none of the other object-specific fields, such as
 autoescaping):
 
-    $old_query = new CGI;
-    $new_query = new CGI($old_query);
+    $old_query = CGI->new;
+    $new_query = CGI->new($old_query);
 
 To create an empty query, initialize it from an empty string or hash:
 
-   $empty_query = new CGI("");
+   $empty_query = CGI->new("");
 
        -or-
 
-   $empty_query = new CGI({});
+   $empty_query = CGI->new({});
 
 =head2 FETCHING A LIST OF KEYWORDS FROM THE QUERY:
 
@@ -4708,7 +4762,7 @@ a short example of creating multiple session records:
    open (OUT,">>test.out") || die;
    $records = 5;
    for (0..$records) {
-       my $q = new CGI;
+       my $q = CGI->new;
        $q->param(-name=>'counter',-value=>$_);
        $q->save(\*OUT);
    }
@@ -4717,7 +4771,7 @@ a short example of creating multiple session records:
    # reopen for reading
    open (IN,"test.out") || die;
    while (!eof(IN)) {
-       my $q = new CGI(\*IN);
+       my $q = CGI->new(\*IN);
        print $q->param('counter'),"\n";
    }
 
@@ -4806,12 +4860,11 @@ Import all methods that generate HTML 4 elements (such as
 
 =item B<:netscape>
 
-Import all methods that generate Netscape-specific HTML extensions.
+Import the <blink>, <fontsize> and <center> tags. 
 
 =item B<:html>
 
-Import all HTML-generating shortcuts (i.e. 'html2' + 'html3' +
-'netscape')...
+Import all HTML-generating shortcuts (i.e. 'html2', 'html3', 'html4' and 'netscape')
 
 =item B<:standard>
 
@@ -4894,11 +4947,11 @@ The current list of pragmas is as follows:
 
 When you I<use CGI -any>, then any method that the query object
 doesn't recognize will be interpreted as a new HTML tag.  This allows
-you to support the next I<ad hoc> Netscape or Microsoft HTML
+you to support the next I<ad hoc> HTML
 extension.  This lets you go wild with new and unsupported tags:
 
    use CGI qw(-any);
-   $q=new CGI;
+   $q=CGI->new;
    print $q->gradient({speed=>'fast',start=>'red',end=>'blue'});
 
 Since using <cite>any</cite> causes any mistyped method name
@@ -4961,7 +5014,8 @@ By default, CGI.pm versions 2.69 and higher emit XHTML
 feature.  Thanks to Michalis Kabrianis <kabrianis@hellug.gr> for this
 feature.
 
-If start_html()'s -dtd parameter specifies an HTML 2.0 or 3.2 DTD, 
+If start_html()'s -dtd parameter specifies an HTML 2.0, 
+3.2, 4.0 or 4.01 DTD, 
 XHTML will automatically be disabled without needing to use this 
 pragma.
 
@@ -4989,11 +5043,9 @@ semicolons rather than ampersands.  For example:
 
    ?name=fred;age=24;favorite_color=3
 
-Semicolon-delimited query strings are always accepted, but will not be
-emitted by self_url() and query_string() unless the -newstyle_urls
-pragma is specified.
-
-This became the default in version 2.64.
+Semicolon-delimited query strings are always accepted, and will be emitted by
+self_url() and query_string(). newstyle_urls became the default in version
+2.64.
 
 =item -oldstyle_urls
 
@@ -5184,7 +5236,7 @@ indicated expiration date.  The following forms are all valid for the
 
 The B<-cookie> parameter generates a header that tells the browser to provide
 a "magic cookie" during all subsequent transactions with your script.
-Netscape cookies have a special format that includes interesting attributes
+Some cookies have a special format that includes interesting attributes
 such as expiration time.  Use the cookie() method to create and retrieve
 session cookies.
 
@@ -5276,7 +5328,7 @@ This method returns a canned HTML header and the opening <body> tag.
 All parameters are optional.  In the named parameter form, recognized
 parameters are -title, -author, -base, -xbase, -dtd, -lang and -target
 (see below for the explanation).  Any additional parameters you
-provide, such as the Netscape unofficial BGCOLOR attribute, are added
+provide, such as the unofficial BGCOLOR attribute, are added
 to the <body> tag.  Additional parameters must be proceeded by a
 hyphen.
 
@@ -5289,9 +5341,7 @@ All relative links will be interpreted relative to this tag.
 
 The argument B<-target> allows you to provide a default target frame
 for all the links and fill-out forms on the page.  B<This is a
-non-standard HTTP feature which only works with Netscape browsers!>
-See the Netscape documentation on frames for details of how to
-manipulate this.
+non-standard HTTP feature which only works with some browsers!>
 
     -target=>"answer_window"
 
@@ -5357,7 +5407,7 @@ And here's how to create an HTTP-EQUIV <meta> tag:
 
 JAVASCRIPTING: The B<-script>, B<-noScript>, B<-onLoad>,
 B<-onMouseOver>, B<-onMouseOut> and B<-onUnload> parameters are used
-to add Netscape JavaScript calls to your pages.  B<-script> should
+to add JavaScript calls to your pages.  B<-script> should
 point to a block of text containing JavaScript function definitions.
 This block will be placed within a <script> block inside the HTML (not
 HTTP) header.  The block is placed in the header in order to give your
@@ -5373,7 +5423,7 @@ code to execute when the page is respectively opened and closed by the
 browser.  Usually these parameters are calls to functions defined in the
 B<-script> field:
 
-      $query = new CGI;
+      $query = CGI->new;
       print header;
       $JSCRIPT=<<END;
       // Ask a silly question
@@ -5464,7 +5514,7 @@ but makes the document hierarchy non-portable.  Use with care!
 =item 4, 5, 6...
 
 Any other parameters you want to include in the <body> tag.  This is a good
-place to put Netscape extensions, such as colors and wallpaper patterns.
+place to put HTML extensions, such as colors and wallpaper patterns.
 
 =back
 
@@ -5776,6 +5826,13 @@ passing a -charset argument to header(), then B<all> characters will
 be replaced by their numeric entities, since CGI.pm has no lookup
 table for all the possible encodings.
 
+C<escapeHTML()> expects the supplied string to be a character string. This means you
+should Encode::decode data received from "outside" and Encode::encode your
+strings before sending them back outside. If your source code UTF-8 encoded and
+you want to upgrade string literals in your source to character strings, you
+can use "use utf8". See L<perlunitut>, L<perlunifaq> and L<perlunicode> for more
+information on how Perl handles the difference between bytes and characters.
+
 The automatic escaping does not apply to other shortcuts, such as
 h1().  You should call escapeHTML() yourself on untrusted data in
 order to protect your pages against nasty tricks that people may enter
@@ -5836,8 +5893,12 @@ your ability to incorporate special HTML character sequences, such as &Aacute;,
 into your fields.  If you wish to turn off automatic escaping, call the
 autoEscape() method with a false value immediately after creating the CGI object:
 
-   $query = new CGI;
-   autoEscape(undef);
+   $query = CGI->new;
+   $query->autoEscape(0);
+
+Note that autoEscape() is exclusively used to effect the behavior of how some
+CGI.pm HTML generation fuctions handle escaping. Calling escapeHTML()
+explicitly will always escape the HTML.
 
 I<A Lurking Trap!> Some of the form-element generating methods return
 multiple tags.  In a scalar context, the tags will be concatenated
@@ -5885,7 +5946,8 @@ action and form encoding that you specify.  The defaults are:
 
     method: POST
     action: this script
-    enctype: application/x-www-form-urlencoded
+    enctype: application/x-www-form-urlencoded for non-XHTML
+             multipart/form-data for XHTML, see mulitpart/form-data below.
 
 end_form() returns the closing </form> tag.  
 
@@ -5893,25 +5955,25 @@ Start_form()'s enctype argument tells the browser how to package the various
 fields of the form before sending the form to the server.  Two
 values are possible:
 
-B<Note:> These methods were previously named startform() and endform(), and they
-are still recognized as aliases of start_form() and end_form().
+B<Note:> These methods were previously named startform() and endform().
+These methods are now DEPRECATED.
+Please use start_form() and end_form() instead.
 
 =over 4
 
 =item B<application/x-www-form-urlencoded>
 
-This is the older type of encoding used by all browsers prior to
-Netscape 2.0.  It is compatible with many CGI scripts and is
+This is the older type of encoding.  It is compatible with many CGI scripts and is
 suitable for short fields containing text data.  For your
 convenience, CGI.pm stores the name of this encoding
 type in B<&CGI::URL_ENCODED>.
 
 =item B<multipart/form-data>
 
-This is the newer type of encoding introduced by Netscape 2.0.
+This is the newer type of encoding.
 It is suitable for forms that contain very large fields or that
 are intended for transferring binary data.  Most importantly,
-it enables the "file upload" feature of Netscape 2.0 forms.  For
+it enables the "file upload" feature.  For
 your convenience, CGI.pm stores the name of this encoding type
 in B<&CGI::MULTIPART>
 
@@ -5924,10 +5986,11 @@ created using this type of encoding.
 
 =back
 
-For compatibility, the start_form() method uses the older form of
-encoding by default.  If you want to use the newer form of encoding
-by default, you can call B<start_multipart_form()> instead of
-B<start_form()>.
+The start_form() method uses the older form of encoding by
+default unless XHTML is requested.  If you want to use the
+newer form of encoding by default, you can call
+B<start_multipart_form()> instead of B<start_form()>.  The
+method B<end_multipart_form()> is an alias to B<end_form()>.
 
 JAVASCRIPTING: The B<-name> and B<-onSubmit> parameters are provided
 for use with JavaScript.  The -name parameter gives the
@@ -6081,7 +6144,7 @@ will be starred out on the web page.
 
     print filefield('uploaded_file','starting value',50,80);
 
-filefield() will return a file upload field for Netscape 2.0 browsers.
+filefield() will return a file upload field.
 In order to take full advantage of this I<you must use the new 
 multipart encoding scheme> for the form.  You can do this either
 by calling B<start_form()> with an encoding type of B<&CGI::MULTIPART>,
@@ -6119,75 +6182,55 @@ field will accept (-maxlength).
 
 =back
 
-When the form is processed, you can retrieve the entered filename
-by calling param():
+JAVASCRIPTING: The B<-onChange>, B<-onFocus>, B<-onBlur>,
+B<-onMouseOver>, B<-onMouseOut> and B<-onSelect> parameters are
+recognized.  See textfield() for details.
 
-       $filename = param('uploaded_file');
+=head2 PROCESSING A FILE UPLOAD FIELD
 
-Different browsers will return slightly different things for the
-name.  Some browsers return the filename only.  Others return the full
-path to the file, using the path conventions of the user's machine.
-Regardless, the name returned is always the name of the file on the
-I<user's> machine, and is unrelated to the name of the temporary file
-that CGI.pm creates during upload spooling (see below).
+=head3 Basics
 
-The filename returned is also a file handle.  You can read the contents
-of the file using standard Perl file reading calls:
+When the form is processed, you can retrieve an L<IO::Handle> compatibile
+handle for a file upload field like this:
 
-       # Read a text file and print it out
-       while (<$filename>) {
-          print;
-       }
+  $lightweight_fh  = $q->upload('field_name');
+
+  # 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;
 
-       # Copy a binary file to somewhere safe
        open (OUTFILE,">>/usr/local/web/users/feedback");
-       while ($bytesread=read($filename,$buffer,1024)) {
+   while ($bytesread = $io_handle->read($buffer,1024)) {
           print OUTFILE $buffer;
        }
-
-However, there are problems with the dual nature of the upload fields.
-If you C<use strict>, then Perl will complain when you try to use a
-string as a filehandle.  You can get around this by placing the file
-reading code in a block containing the C<no strict> pragma.  More
-seriously, it is possible for the remote user to type garbage into the
-upload field, in which case what you get from param() is not a
-filehandle at all, but a string.
-
-To be safe, use the I<upload()> function (new in version 2.47).  When
-called with the name of an upload field, I<upload()> returns a
-filehandle-like object, or undef if the parameter is not a valid
-filehandle.
-
-     $fh = upload('uploaded_file');
-     while (<$fh>) {
-          print;
-     }
+  }
 
 In a list context, upload() will return an array of filehandles.
-This makes it possible to create forms that use the same name for
+This makes it possible to process forms that use the same name for
 multiple upload fields.
 
-This is the recommended idiom.
+If you want the entered file name for the file, you can just call param():
 
-The lightweight filehandle returned by CGI.pm is not compatible with
-IO::Handle; for example, it does not have read() or getline()
-functions, but instead must be manipulated using read($fh) or
-<$fh>. To get a compatible IO::Handle object, call the handle's
-handle() method:
+  $filename = $q->param('field_name');
 
-  my $real_io_handle = upload('uploaded_file')->handle;
+Different browsers will return slightly different things for the
+name.  Some browsers return the filename only.  Others return the full
+path to the file, using the path conventions of the user's machine.
+Regardless, the name returned is always the name of the file on the
+I<user's> machine, and is unrelated to the name of the temporary file
+that CGI.pm creates during upload spooling (see below).
 
 When a file is uploaded the browser usually sends along some
 information along with it in the format of headers.  The information
-usually includes the MIME content type.  Future browsers may send
-other information as well (such as modification date and size). To
+usually includes the MIME content type. To
 retrieve this information, call uploadInfo().  It returns a reference to
 a hash containing all the document headers.
 
-       $filename = param('uploaded_file');
-       $type = uploadInfo($filename)->{'Content-Type'};
+       $filename = $q->param('uploaded_file');
+       $type = $q->uploadInfo($filename)->{'Content-Type'};
        unless ($type eq 'text/html') {
-         die "HTML FILES ONLY!";
+        die "HTML FILES ONLY!";
        }
 
 If you are using a machine that recognizes "text" and "binary" data
@@ -6195,6 +6238,24 @@ modes, be sure to understand when and how to use them (see the Camel book).
 Otherwise you may find that binary files are corrupted during file
 uploads.
 
+=head3 Accessing the temp files directly
+
+When processing an uploaded file, CGI.pm creates a temporary file on your hard
+disk and passes you a file handle to that file. After you are finished with the
+file handle, CGI.pm unlinks (deletes) the temporary file. If you need to you
+can access the temporary file directly. You can access the temp file for a file
+upload by passing the file name to the tmpFileName() method:
+
+       $filename = $query->param('uploaded_file');
+       $tmpfilename = $query->tmpFileName($filename);
+
+The temporary file will be deleted automatically when your program exits unless
+you manually rename it. On some operating systems (such as Windows NT), you
+will need to close the temporary file's filehandle before your program exits.
+Otherwise the attempt to delete the temporary file will fail.
+
+=head3 Handling interrupted file uploads
+
 There are occasionally problems involving parsing the uploaded file.
 This usually happens when the user presses "Stop" before the upload is
 finished.  In this case, CGI.pm will return undef for the name of the
@@ -6203,35 +6264,39 @@ uploaded file and set I<cgi_error()> to the string "400 Bad request
 you can incorporate it into a status code to be sent to the browser.
 Example:
 
-   $file = upload('uploaded_file');
-   if (!$file && cgi_error) {
-      print header(-status=>cgi_error);
+   $file = $q->upload('uploaded_file');
+   if (!$file && $q->cgi_error) {
+      print $q->header(-status=>$q->cgi_error);
       exit 0;
    }
 
 You are free to create a custom HTML page to complain about the error,
 if you wish.
 
-You can set up a callback that will be called whenever a file upload
-is being read during the form processing. This is much like the
-UPLOAD_HOOK facility available in Apache::Request, with the exception
-that the first argument to the callback is an Apache::Upload object,
-here it's the remote filename.
+=head3 Progress bars for file uploads and avoiding temp files
+
+CGI.pm gives you low-level access to file upload management through
+a file upload hook. You can use this feature to completely turn off
+the temp file storage of file uploads, or potentially write your own
+file upload progess meter.
+
+This is much like the UPLOAD_HOOK facility available in L<Apache::Request>, with
+the exception that the first argument to the callback is an L<Apache::Upload>
+object, here it's the remote filename.
 
  $q = CGI->new(\&hook [,$data [,$use_tempfile]]);
 
- sub hook
- {
+ sub hook {
         my ($filename, $buffer, $bytes_read, $data) = @_;
-        print  "Read $bytes_read bytes of $filename\n";         
+        print  "Read $bytes_read bytes of $filename\n";
  }
 
-The $data field is optional; it lets you pass configuration
+The C<< $data >> field is optional; it lets you pass configuration
 information (e.g. a database handle) to your hook callback.
 
-The $use_tempfile field is a flag that lets you turn on and off
+The C<< $use_tempfile >> field is a flag that lets you turn on and off
 CGI.pm's use of a temporary disk-based file during file upload. If you
-set this to a FALSE value (default true) then param('uploaded_file')
+set this to a FALSE value (default true) then $q->param('uploaded_file')
 will no longer work, and the only way to get at the uploaded data is
 via the hook you provide.
 
@@ -6243,15 +6308,34 @@ method before calling param() or any other CGI functions:
 This method is not exported by default.  You will have to import it
 explicitly if you wish to use it without the CGI:: prefix.
 
+=head3 Troubleshooting file uploads on Windows
+
 If you are using CGI.pm on a Windows platform and find that binary
 files get slightly larger when uploaded but that text files remain the
 same, then you have forgotten to activate binary mode on the output
 filehandle.  Be sure to call binmode() on any handle that you create
 to write the uploaded file to disk.
 
-JAVASCRIPTING: The B<-onChange>, B<-onFocus>, B<-onBlur>,
-B<-onMouseOver>, B<-onMouseOut> and B<-onSelect> parameters are
-recognized.  See textfield() for details.
+=head3 Older ways to process file uploads
+
+( This section is here for completeness. if you are building a new application with CGI.pm, you can skip it. )
+
+The original way to process file uploads with CGI.pm was to use param(). The
+value it returns has a dual nature as both a file name and a lightweight
+filehandle. This dual nature is problematic if you following the recommended
+practice of having C<use strict> in your code. Perl will complain when you try
+to use a string as a filehandle.  More seriously, it is possible for the remote
+user to type garbage into the upload field, in which case what you get from
+param() is not a filehandle at all, but a string.
+
+To solve this problem the upload() method was added, which always returns a
+lightweight filehandle. This generally works well, but will have trouble
+interoperating with some other modules because the file handle is not derived
+from L<IO::Handle>. So that brings us to current recommedation given above,
+which is to call the handle() method on the file handle returned by upload().
+That upgrades the handle to an IO::Handle. It's a big win for compatibility for
+a small penalty of loading IO::Handle the first time you call it.
+
 
 =head2 CREATING A POPUP MENU
 
@@ -6526,7 +6610,7 @@ list.  Otherwise, they will be strung together on a horizontal line.
 =back
 
 
-The optional b<-labels> argument is a pointer to a hash
+The optional B<-labels> argument is a pointer to a hash
 relating the checkbox values to the user-visible labels that will be
 printed next to them.  If not provided, the values will be used as the
 default.
@@ -6538,7 +6622,7 @@ checkbox group formatted with the specified number of rows and
 columns.  You can provide just the -columns parameter if you wish;
 checkbox_group will calculate the correct number of rows for you.
 
-The option b<-disabled> takes an array of checkbox values and disables
+The option B<-disabled> takes an array of checkbox values and disables
 them by greying them out (this may not be supported by all browsers).
 
 The optional B<-attributes> argument is provided to assign any of the
@@ -6883,11 +6967,11 @@ Fetch the value of the button this way:
 
        -or-
 
-     print button('button_name',"do_something()");
+     print button('button_name',"user visible value","do_something()");
 
-button() produces a button that is compatible with Netscape 2.0's
-JavaScript.  When it's pressed the fragment of JavaScript code
-pointed to by the B<-onClick> parameter will be executed.
+button() produces an C<< <input> >> tag with C<type="button">.  When it's
+pressed the fragment of JavaScript code pointed to by the B<-onClick> parameter
+will be executed.
 
 =head1 HTTP COOKIES
 
@@ -7017,7 +7101,7 @@ without the B<-value> parameter. This example uses the object-oriented
 form:
 
        use CGI;
-       $query = new CGI;
+       $query = CGI->new;
        $riddle = $query->cookie('riddle_name');
         %answers = $query->cookie('answers');
 
@@ -7059,10 +7143,7 @@ document that defines the frames on the page.  Specify your script(s)
 (with appropriate parameters) as the SRC for each of the frames.
 
 There is no specific support for creating <frameset> sections 
-in CGI.pm, but the HTML is very simple to write.  See the frame
-documentation in Netscape's home pages for details 
-
-  http://wp.netscape.com/assist/net_sites/frames.html
+in CGI.pm, but the HTML is very simple to write.  
 
 =item 2. Specify the destination for the document in the HTTP header
 
@@ -7074,8 +7155,7 @@ This will tell the browser to load the output of your script into the
 frame named "ResultsWindow".  If a frame of that name doesn't already
 exist, the browser will pop up a new window and load your script's
 document into that.  There are a number of magic names that you can
-use for targets.  See the frame documents on Netscape's home pages for
-details.
+use for targets.  See the HTML C<< <frame> >> documentation for details.
 
 =item 3. Specify the destination for the document in the <form> tag
 
@@ -7224,7 +7304,7 @@ start_html() method provides a convenient way to create this section.
 Similarly, you can create a form that checks itself over for
 consistency and alerts the user if some essential value is missing by
 creating it this way: 
-  print startform(-onSubmit=>"validateMe(this)");
+  print start_form(-onSubmit=>"validateMe(this)");
 
 See the javascript.cgi script for a demonstration of how this all
 works.
@@ -7267,7 +7347,7 @@ section of text:
 Note that you must import the ":html3" definitions to have the
 B<span()> method available.  Here's a quick and dirty example of using
 CSS's.  See the CSS specification at
-http://www.w3.org/pub/WWW/TR/Wd-css-1.html for more information.
+http://www.w3.org/Style/CSS/ for more information.
 
     use CGI qw/:standard :html3/;
 
@@ -7413,7 +7493,7 @@ Produces something that looks like:
 As a shortcut, you can interpolate the entire CGI object into a string
 and it will be replaced with the a nice HTML dump shown above:
 
-    $query=new CGI;
+    $query=CGI->new;
     print "<h2>Current Values</h2> $query\n";
 
 =head1 FETCHING ENVIRONMENT VARIABLES
@@ -7484,6 +7564,11 @@ path as well.
 Returns either the remote host name or IP address.
 if the former is unavailable.
 
+=item B<remote_addr()>
+
+Returns the remote host IP address, or 
+127.0.0.1 if the address is unavailable.
+
 =item B<script_name()>
 Return the script name as a partial URL, for self-refering
 scripts.
@@ -7592,9 +7677,9 @@ running under IIS and put itself into this mode.  You do not need to
 do this manually, although it won't hurt anything if you do.  However,
 note that if you have applied Service Pack 6, much of the
 functionality of NPH scripts, including the ability to redirect while
-setting a cookie, b<do not work at all> on IIS without a special patch
+setting a cookie, B<do not work at all> on IIS without a special patch
 from Microsoft.  See
-http://support.microsoft.com/support/kb/articles/Q280/3/41.ASP:
+http://web.archive.org/web/20010812012030/http://support.microsoft.com/support/kb/articles/Q280/3/41.ASP
 Non-Parsed Headers Stripped From CGI Applications That Have nph-
 Prefix in Name.
 
@@ -7964,7 +8049,11 @@ Please report them.
 
 =head1 SEE ALSO
 
-L<CGI::Carp>, L<CGI::Fast>, L<CGI::Pretty>
+L<CGI::Carp> - provides a L<Carp> implementation tailored to the CGI environment.
+
+L<CGI::Fast> - supports running CGI applications under FastCGI
+
+L<CGI::Pretty> - pretty prints HTML generated by CGI.pm (with a performance penalty)
 
 =cut
 
index aa79d19..381635e 100644 (file)
@@ -70,6 +70,8 @@ compiler errors will be caught.  Example:
    }
 
 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
@@ -77,7 +79,7 @@ browser when the script closes STDOUT and STDERR.  CGI::Carp::SAVEERR is there t
 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 
+way according to Tom Christiansen is to pass a reference to a filehandle
 GLOB:
 
     carpout(\*LOG);
index f2535f4..85a07f0 100644 (file)
@@ -363,7 +363,7 @@ MS Internet Explorer 6 Service Pack 1 and later.
 
 See this URL for more information:
 
-L<http://msdn.microsoft.com/workshop/author/dhtml/httponly_cookies.asp>
+L<http://msdn.microsoft.com/en-us/library/ms533046%28VS.85%29.aspx>
 
 =back
 
index 594cad7..67d67ee 100644 (file)
@@ -1,4 +1,6 @@
 package CGI::Fast;
+use strict;
+$^W=1; # A way to say "use warnings" that's compatible with even older perls.
 
 # See the bottom of this file for the POD documentation.  Search for the
 # string '=head'.
@@ -9,7 +11,7 @@ package CGI::Fast;
 
 # Copyright 1995,1996, Lincoln D. Stein.  All rights reserved.
 # It may be used and modified freely, but I do request that this copyright
-# notice remain attached to the file.  You may modify this module as you 
+# notice remain attached to the file.  You may modify this module as you
 # wish, but if you redistribute a modified version, please attach a note
 # listing the modifications you have made.
 
@@ -17,13 +19,18 @@ $CGI::Fast::VERSION='1.07';
 
 use CGI;
 use FCGI;
+# use vars works like "our", but is compatible with older Perls.
+use vars qw(
+    @ISA
+    $ignore
+);
 @ISA = ('CGI');
 
 # workaround for known bug in libfcgi
 while (($ignore) = each %ENV) { }
 
 # override the initialization behavior so that
-# state is NOT maintained between invocations 
+# state is NOT maintained between invocations
 sub save_request {
     # no-op
 }
@@ -38,7 +45,7 @@ BEGIN {
        my $path    = $ENV{FCGI_SOCKET_PATH};
        my $backlog = $ENV{FCGI_LISTEN_QUEUE} || 100;
        my $socket  = FCGI::OpenSocket( $path, $backlog );
-       $Ext_Request = FCGI::Request( \*STDIN, \*STDOUT, \*STDERR, 
+       $Ext_Request = FCGI::Request( \*STDIN, \*STDOUT, \*STDERR,
                                        \%ENV, $socket, 1 );
    }
 }
@@ -55,7 +62,7 @@ sub new {
      }
      }
      CGI->_reset_globals;
-     $self->_setup_symbols(@SAVED_SYMBOLS) if @CGI::SAVED_SYMBOLS;
+     $self->_setup_symbols(@CGI::SAVED_SYMBOLS) if @CGI::SAVED_SYMBOLS;
      return $CGI::Q = $self->SUPER::new($initializer, @param);
 }
 
@@ -96,10 +103,10 @@ http://www.cpan.org/ for details.
 
 =head1 WRITING FASTCGI PERL SCRIPTS
 
-FastCGI scripts are persistent: one or more copies of the script 
+FastCGI scripts are persistent: one or more copies of the script
 are started up when the server initializes, and stay around until
 the server exits or they die a natural death.  After performing
-whatever one-time initialization it needs, the script enters a 
+whatever one-time initialization it needs, the script enters a
 loop waiting for incoming connections, processing the request, and
 waiting some more.
 
@@ -143,7 +150,7 @@ install, you must add something like the following to srm.conf:
 
     FastCgiServer /usr/etc/httpd/fcgi-bin/file_upload.fcgi -processes 2
 
-This instructs Apache to launch two copies of file_upload.fcgi at 
+This instructs Apache to launch two copies of file_upload.fcgi at
 startup time.
 
 =head1 USING FASTCGI SCRIPTS AS CGI SCRIPTS
@@ -174,7 +181,7 @@ script to which bind an listen for incoming connections from the web server.
 
 =item FCGI_LISTEN_QUEUE
 
-Maximum length of the queue of pending connections.  
+Maximum length of the queue of pending connections.
 
 =back
 
@@ -195,7 +202,7 @@ I haven't tested this very much.
 
 =head1 AUTHOR INFORMATION
 
-Copyright 1996-1998, Lincoln D. Stein.  All rights reserved.  
+Copyright 1996-1998, Lincoln D. Stein.  All rights reserved.
 
 This library is free software; you can redistribute it and/or modify
 it under the same terms as Perl itself.
index 83d5a58..3567478 100644 (file)
@@ -10,7 +10,7 @@ package CGI::Pretty;
 use strict;
 use CGI ();
 
-$CGI::Pretty::VERSION = '3.44';
+$CGI::Pretty::VERSION = '3.46';
 $CGI::DefaultClass = __PACKAGE__;
 $CGI::Pretty::AutoloadClass = 'CGI';
 @CGI::Pretty::ISA = qw( CGI );
@@ -114,9 +114,8 @@ sub _make_tag_func {
 
             my \@result;
             if ( exists \$ASIS{ "\L$tagname\E" } ) {
-               \@result = map { "\$tag\$_\$untag\$CGI::Pretty::LINEBREAK" } 
-                \@args;
-           }
+                \@result = map { "\$tag\$_\$untag" } \@args;
+            }
            else {
                \@result = map { 
                    chomp; 
@@ -173,6 +172,7 @@ sub initialize_globals {
     $CGI::Pretty::LINEBREAK = $/;
 
     # These tags are not prettify'd.
+    # When this list is updated, also update the docs.
     @CGI::Pretty::AS_IS = qw( a pre code script textarea td );
 
     1;
@@ -245,21 +245,29 @@ it.
 now produces the following output:
     <TABLE>
        <TR>
-          <TD>
-             foo
-          </TD>
+          <TD>foo</TD>
        </TR>
     </TABLE>
 
+=head2 Recommendation for when to use CGI::Pretty
+
+CGI::Pretty is far slower than using CGI.pm directly. A benchmark showed that
+it could be about 10 times slower. Adding newslines and spaces may alter the
+rendered appearance of HTML. Also, the extra newlines and spaces also make the
+file size larger, making the files take longer to download.
+
+With all those considerations, it is recommended that CGI::Pretty be used
+primarily for debugging.
 
 =head2 Tags that won't be formatted
 
-The <A> and <PRE> tags are not formatted.  If these tags were formatted, the
+The following tags are not formatted: <a>, <pre>, <code>, <script>, <textarea>, and <td>.
+If these tags were formatted, the
 user would see the extra indentation on the web browser causing the page to
 look different than what would be expected.  If you wish to add more tags to
 the list of tags that are not to be touched, push them onto the C<@AS_IS> array:
 
-    push @CGI::Pretty::AS_IS,qw(CODE XMP);
+    push @CGI::Pretty::AS_IS,qw(XMP);
 
 =head2 Customizing the Indenting
 
@@ -282,10 +290,6 @@ the following:
 
     $CGI::Pretty::INDENT = $CGI::Pretty::LINEBREAK = "";
 
-=head1 BUGS
-
-This section intentionally left blank.
-
 =head1 AUTHOR
 
 Brian Paulsen <Brian@ThePaulsens.com>, with minor modifications by
index 9a0ea2b..1f4201d 100644 (file)
@@ -7,7 +7,7 @@ require Exporter;
 @EXPORT_OK = qw(rearrange rearrange_header make_attributes unescape escape 
                expires ebcdic2ascii ascii2ebcdic);
 
-$VERSION = '3.45';
+$VERSION = '3.48';
 
 $EBCDIC = "\t" ne "\011";
 # (ord('^') == 95) for codepage 1047 as on os390, vmesa
@@ -248,7 +248,7 @@ 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.007 && utf8::is_utf8($toencode));
+  utf8::encode($toencode) if ($] > 5.008001 && utf8::is_utf8($toencode));
     if ($EBCDIC) {
       $toencode=~s/([^a-zA-Z0-9_.~-])/uc sprintf("%%%02x",$E2A[ord($1)])/eg;
     } else {
index 7f92155..5a048c0 100644 (file)
@@ -1,11 +1,5 @@
 #!/usr/local/bin/perl -w
 
-use lib qw(t/lib);
-
-# Due to a bug in older versions of MakeMaker & Test::Harness, we must
-# ensure the blib's are in @INC, else we might use the core CGI.pm
-use lib qw(blib/lib blib/arch);
-
 use strict;
 use Test::More tests => 1;
 
diff --git a/cpan/CGI/t/autoescape.t b/cpan/CGI/t/autoescape.t
new file mode 100644 (file)
index 0000000..4117298
--- /dev/null
@@ -0,0 +1,199 @@
+#!perl
+
+use strict;
+use warnings;
+
+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 /;
+
+is (button(-name => 'test<'), '<input type="button"  name="test&lt;" value="test&lt;" />', "autoEscape defaults to On");
+
+my $before = escapeHTML("test<");
+autoEscape(undef);
+my $after = escapeHTML("test<");
+
+
+is($before, "test&lt;", "reality check escapeHTML");
+
+is ($before, $after, "passing undef to autoEscape doesn't break escapeHTML"); 
+is (button(-name => 'test<'), '<input type="button"  name="test<" value="test<" />', "turning off autoescape actually works");
+autoEscape(1);
+is (button(-name => 'test<'), '<input type="button"  name="test&lt;" value="test&lt;" />', "autoescape turns back on");
+$before = escapeHTML("test<");
+autoEscape(0);
+$after = escapeHTML("test<");
+
+is ($before, $after, "passing 0 to autoEscape doesn't break escapeHTML"); 
+
+# RT #25485: Needs Tests: autoEscape() bypassed for Javascript handlers, except in button()
+autoEscape(undef);
+is(textfield(
+{
+default => 'text field',
+onclick => 'alert("===> text field")',
+},
+),
+qq{<input type="text" name="" value="text field" onclick="alert("===> text field")" />},
+'autoescape javascript turns off for textfield'
+);
+
+is(password_field(
+{
+default => 'password field',
+onclick => 'alert("===> password
+field")',
+},
+),
+qq{<input type="password" name="" value="password field" onclick="alert("===> password
+field")" />},
+'autoescape javascript turns off for password field'
+);
+
+is(textarea(
+{
+name => 'foo',
+default => 'text area',
+rows => 10,
+columns => 50,
+onclick => 'alert("===> text area")',
+},
+),
+qq{<textarea name="foo"  rows="10" cols="50" onclick="alert("===> text area")">text area</textarea>},
+'autoescape javascript turns off for textarea'
+);
+
+is(popup_menu(
+{
+name => 'menu_name',
+values => ['eenie','meenie','minie'],
+default => 'meenie',
+onclick => 'alert("===> popup menu")',
+}
+),
+qq{<select name="menu_name"  onclick="alert("===> popup menu")">
+<option value="eenie">eenie</option>
+<option selected="selected" value="meenie">meenie</option>
+<option value="minie">minie</option>
+</select>},
+'autoescape javascript turns off for popup_menu'
+);
+
+is(popup_menu(
+-name=>'menu_name',
+onclick => 'alert("===> menu group")',
+-values=>[
+qw/eenie meenie minie/,
+optgroup(
+-name=>'optgroup_name',
+onclick =>
+'alert("===> menu group option")',
+-values => ['moe','catch'],
+-attributes=>{'catch'=>{'class'=>'red'}}
+)
+],
+-labels=>{
+'eenie'=>'one',
+'meenie'=>'two',
+'minie'=>'three'
+},
+-default=>'meenie'
+),
+qq{<select name="menu_name"  onclick="alert("===> menu group")">
+<option value="eenie">one</option>
+<option selected="selected" value="meenie">two</option>
+<option value="minie">three</option>
+<optgroup label="optgroup_name" onclick="alert("===> menu group option")">
+<option value="moe">moe</option>
+<option class="red" value="catch">catch</option>
+</optgroup>
+</select>},
+'autoescape javascript turns off for popup_menu #2'
+);
+
+is(scrolling_list(
+-name=>'list_name',
+onclick => 'alert("===> scrolling
+list")',
+-values=>['eenie','meenie','minie','moe'],
+-default=>['eenie','moe'],
+-size=>5,
+-multiple=>'true',
+),
+qq{<select name="list_name"  size="5" multiple="multiple" onclick="alert("===> scrolling
+list")">
+<option selected="selected" value="eenie">eenie</option>
+<option value="meenie">meenie</option>
+<option value="minie">minie</option>
+<option selected="selected" value="moe">moe</option>
+</select>},
+'autoescape javascript turns off for scrolling list'
+);
+
+is(checkbox_group(
+-name=>'group_name',
+onclick => 'alert("===> checkbox group")',
+-values=>['eenie','meenie','minie','moe'],
+-default=>['eenie','moe'],
+-linebreak=>'true',
+),
+qq{<label><input type="checkbox" name="group_name" value="eenie" checked="checked" onclick="alert("===> checkbox group")" />eenie</label><br /> <label><input type="checkbox" name="group_name" value="meenie" onclick="alert("===> checkbox group")" />meenie</label><br /> <label><input type="checkbox" name="group_name" value="minie" onclick="alert("===> checkbox group")" />minie</label><br /> <label><input type="checkbox" name="group_name" value="moe" checked="checked" onclick="alert("===> checkbox group")" />moe</label><br />},
+'autoescape javascript turns off for checkbox group'
+);
+
+is(checkbox(
+-name=>'checkbox_name',
+onclick => 'alert("===> single checkbox")',
+onchange => 'alert("===> single checkbox
+changed")',
+-checked=>1,
+-value=>'ON',
+-label=>'CLICK ME'
+),
+qq{<label><input type="checkbox" name="checkbox_name" value="ON" checked="checked" onchange="alert("===> single checkbox
+changed")" onclick="alert("===> single checkbox")" />CLICK ME</label>},
+'autoescape javascript turns off for checkbox'
+);
+
+is(radio_group(
+{
+name=>'group_name',
+onclick => 'alert("===> radio group")',
+values=>['eenie','meenie','minie','moe'],
+rows=>2,
+columns=>2,
+}
+),
+qq{<table><tr><td><label><input type="radio" name="group_name" value="eenie" checked="checked" onclick="alert("===> radio group")" />eenie</label></td><td><label><input type="radio" name="group_name" value="minie" onclick="alert("===> radio group")" />minie</label></td></tr><tr><td><label><input type="radio" name="group_name" value="meenie" onclick="alert("===> radio group")" />meenie</label></td><td><label><input type="radio" name="group_name" value="moe" onclick="alert("===> radio group")" />moe</label></td></tr></table>},
+'autoescape javascript turns off for radio group'
+);
+
+is(submit(
+-name=>'button_name',
+onclick => 'alert("===> submit button")',
+-value=>'value'
+),
+qq{<input type="submit" name="button_name" value="value" onclick="alert("===> submit button")" />},
+'autoescape javascript turns off for submit'
+);
+
+is(image_button(
+-name=>'button_name',
+onclick => 'alert("===> image button")',
+-src=>'/source/URL',
+-align=>'MIDDLE'
+),
+qq{<input type="image" name="button_name" src="/source/URL" align="middle" onclick="alert("===> image button")" />},
+'autoescape javascript turns off for image_button'
+);
+
+is(button(
+{
+onclick => 'alert("===> Button")',
+title => 'Button',
+},
+),
+qq{<input type="button"  onclick="alert("===> Button")" title="Button" />},
+'autoescape javascript turns off for button'
+);
index 720eb49..c4dfd4f 100644 (file)
@@ -1,12 +1,7 @@
 #!/usr/local/bin/perl -w
 
-# Due to a bug in older versions of MakeMaker & Test::Harness, we must
-# ensure the blib's are in @INC, else we might use the core CGI.pm
-
-use lib qw(blib/lib blib/arch);
-
 use Test::More tests => 2;
 
 BEGIN{ use_ok('CGI'); }
 
-can_ok('CGI', qw/cookie param/);
\ No newline at end of file
+can_ok('CGI', qw/cookie param/);
index 6d20a4f..ff5eaf4 100644 (file)
@@ -2,11 +2,6 @@
 #!/usr/local/bin/perl -w
 
 use strict;
-use lib qw(t/lib);
-
-# Due to a bug in older versions of MakeMaker & Test::Harness, we must
-# ensure the blib's are in @INC, else we might use the core CGI.pm
-use lib qw(blib/lib blib/arch);
 
 use Test::More tests => 41;
 use IO::Handle;
diff --git a/cpan/CGI/t/checkbox_group.t b/cpan/CGI/t/checkbox_group.t
new file mode 100644 (file)
index 0000000..ea5ad08
--- /dev/null
@@ -0,0 +1,21 @@
+#!/usr/local/bin/perl -w
+
+use Test::More tests => 3;
+
+BEGIN { use_ok('CGI'); };
+use CGI (':standard','-no_debug','-no_xhtml');
+
+# no_xhtml test on checkbox_group()
+is(checkbox_group(-name       => 'game',
+                 '-values'   => [qw/checkers chess cribbage/],
+                  '-defaults' => ['cribbage']),
+   qq(<input type="checkbox" name="game" value="checkers" >checkers <input type="checkbox" name="game" value="chess" >chess <input type="checkbox" name="game" value="cribbage" checked >cribbage),
+   'checkbox_group()');
+
+#  xhtml test on checkbox_group()
+$CGI::XHTML = 1;
+is(checkbox_group(-name       => 'game',
+                 '-values'   => [qw/checkers chess cribbage/],
+                  '-defaults' => ['cribbage']),
+   qq(<label><input type="checkbox" name="game" value="checkers" />checkers</label> <label><input type="checkbox" name="game" value="chess" />chess</label> <label><input type="checkbox" name="game" value="cribbage" checked="checked" />cribbage</label>),
+   'checkbox_group()');
index 539ac7a..f5afc18 100644 (file)
@@ -1,12 +1,7 @@
 #!/usr/local/bin/perl -w
 
-use lib qw(t/lib);
 use strict;
 
-# Due to a bug in older versions of MakeMaker & Test::Harness, we must
-# ensure the blib's are in @INC, else we might use the core CGI.pm
-use lib qw(blib/lib blib/arch);
-
 use Test::More tests => 96;
 use CGI::Util qw(escape unescape);
 use POSIX qw(strftime);
diff --git a/cpan/CGI/t/end_form.t b/cpan/CGI/t/end_form.t
new file mode 100644 (file)
index 0000000..fd13106
--- /dev/null
@@ -0,0 +1,13 @@
+
+use strict;
+use warnings;
+
+use Test::More tests => 3;
+
+BEGIN { use_ok 'CGI', qw/ -compile :form / };
+
+is end_form() => '</form>', 'end_form()';
+is endform() => '</form>', 'endform()';
+
+
+
index 45f8e12..355ec82 100644 (file)
@@ -1,11 +1,5 @@
 #!./perl -w
 
-use lib qw(t/lib);
-
-# Due to a bug in older versions of MakeMaker & Test::Harness, we must
-# ensure the blib's are in @INC, else we might use the core CGI.pm
-use lib qw(blib/lib blib/arch);
-
 my $fcgi;
 BEGIN {
        local $@;
@@ -13,7 +7,7 @@ BEGIN {
        $fcgi = $@ ? 0 : 1;
 }
 
-use Test::More tests => 7;
+use Test::More tests => 10;
 
 # Shut up "used only once" warnings.
 () = $CGI::Q;
@@ -22,16 +16,24 @@ use Test::More tests => 7;
 SKIP: {
        skip( 'FCGI not installed, cannot continue', 7 ) unless $fcgi;
 
-       use_ok( CGI::Fast );
+       use 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' );
 
-       ok( $q = CGI::Fast->new({ foo => 'bar' }), 'creating obect with params' );
+       ok( $q = CGI::Fast->new({ foo => 'bar' }), 'creating object with params' );
        is( $q->param('foo'), 'bar', 'checking passed param' );
 
        # if this is false, the package var will be empty
        $ENV{FCGI_SOCKET_PATH} = 0;
-       is( $CGI::Fast::Ext_Request, '', 'checking no active request' );
+       is( $CGI::Fast::Ext_Request, undef, 'checking no active request' );
 
-}
+    is($CGI::PRIVATE_TEMPFILES,0, "reality check default value for CGI::PRIVATE_TEMPFILES");
+       import CGI::Fast '-private_tempfiles';
+    CGI::Fast->new;
+    is($CGI::PRIVATE_TEMPFILES,1, "pragma in subclass set package variable in parent class. ");
+    $q = CGI::Fast->new({ a => 1 });
+    ok($q, "reality check: something was returned from CGI::Fast->new besides undef");
+    is($CGI::PRIVATE_TEMPFILES,1, "package variable in parent class persists through multiple calls to CGI::Fast->new ");
+
+};
index b532db9..a8373c6 100644 (file)
@@ -1,8 +1,10 @@
-#!/usr/local/bin/perl -w
+#!perl -w
 
-use Test::More tests => 22;
+# Form-related tests for CGI.pm
+# If you are adding or updated tests, please put tests for each methods in
+# their own file, rather than growing this file any larger. 
 
-BEGIN { use_ok('CGI'); };
+use Test::More 'no_plan';
 use CGI (':standard','-no_debug','-tabindex');
 
 my $CRLF = "\015\012";
@@ -175,3 +177,69 @@ is(scrolling_list(-name=>'menu_name',
 </select>),
     'scrolling_list() + optgroup()');
 
+# ---------- START 22046 ----------
+# The following tests were added for
+# https://rt.cpan.org/Public/Bug/Display.html?id=22046
+#     SHCOREY at cpan.org
+# Saved whether working with XHTML because need to test both
+# with it and without.
+my $saved_XHTML = $CGI::XHTML;
+
+# set XHTML
+$CGI::XHTML = 1;
+
+is(start_form("GET","/foobar"),
+    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">
+},
+    'start_form() + XHTML + URL_ENCODED');
+
+is(start_form("GET", "/foobar",&CGI::MULTIPART),
+    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">
+},
+    'start_multipart_form() + XHTML');
+
+is(start_multipart_form("GET", "/foobar","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">
+},
+    'start_form() + NO_XHTML');
+
+is(start_form("GET", "/foobar",&CGI::URL_ENCODED),
+    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">
+},
+    'start_form() + NO_XHTML + MULTIPART');
+
+is(start_multipart_form("GET", "/foobar"),
+    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">
+},
+    'start_multipart_form() + NO_XHTML + additional args');
+
+# restoring value
+$CGI::XHTML = $saved_XHTML;
index 4ff67d5..316b585 100644 (file)
@@ -1,11 +1,5 @@
 #!/usr/local/bin/perl -w
 
-use lib qw(t/lib);
-
-# Test ability to retrieve HTTP request info
-######################### We start with some black magic to print on failure.
-use lib '.','..','../blib/lib','../blib/arch';
-
 BEGIN {$| = 1; print "1..32\n"; }
 END {print "not ok 1\n" unless $loaded;}
 use Config;
diff --git a/cpan/CGI/t/hidden.t b/cpan/CGI/t/hidden.t
new file mode 100644 (file)
index 0000000..e8291d7
--- /dev/null
@@ -0,0 +1,38 @@
+#!perl -w
+
+use Test::More 'no_plan';
+use CGI;
+
+my $q = CGI->new;
+
+is( $q->hidden( 'hidden_name', 'foo' ),
+    qq(<input type="hidden" name="hidden_name" value="foo"  />),
+    'hidden() with single default value, positional');
+
+is( $q->hidden( -name => 'hidden_name', -default =>'foo' ),
+    qq(<input type="hidden" name="hidden_name" value="foo"  />),
+    'hidden() with single default value, named');
+
+is( $q->hidden( 'hidden_name', qw(foo bar baz fie) ),
+    qq(<input type="hidden" name="hidden_name" value="foo"  /><input type="hidden" name="hidden_name" value="bar"  /><input type="hidden" name="hidden_name" value="baz"  /><input type="hidden" name="hidden_name" value="fie"  />),
+    'hidden() with default array, positional');
+
+is( $q->hidden( -name=>'hidden_name',
+            -Values =>[qw/foo bar baz fie/],
+            -Title => "hidden_field"),
+     qq(<input type="hidden" name="hidden_name" value="foo" title="hidden_field" /><input type="hidden" name="hidden_name" value="bar" title="hidden_field" /><input type="hidden" name="hidden_name" value="baz" title="hidden_field" /><input type="hidden" name="hidden_name" value="fie" title="hidden_field" />),
+    'hidden() default array, named as "Values"');
+
+is( $q->hidden( -name=>'hidden_name',
+            -default =>[qw/foo bar baz fie/],
+            -Title => "hidden_field"),
+     qq(<input type="hidden" name="hidden_name" value="foo" title="hidden_field" /><input type="hidden" name="hidden_name" value="bar" title="hidden_field" /><input type="hidden" name="hidden_name" value="baz" title="hidden_field" /><input type="hidden" name="hidden_name" value="fie" title="hidden_field" />),
+    'hidden() default array, named as "default"');
+
+is( $q->hidden( -name=>'hidden_name',
+            '-value' =>[qw/foo bar baz fie/],
+            -Title => "hidden_field"),
+     qq(<input type="hidden" name="hidden_name" value="foo" title="hidden_field" /><input type="hidden" name="hidden_name" value="bar" title="hidden_field" /><input type="hidden" name="hidden_name" value="baz" title="hidden_field" /><input type="hidden" name="hidden_name" value="fie" title="hidden_field" />),
+    'hidden() default array, named as "value"');
+
+
index 49cc595..aebe228 100644 (file)
@@ -1,59 +1,79 @@
 #!/usr/local/bin/perl -w
 
-# Test ability to retrieve HTTP request info
-######################### We start with some black magic to print on failure.
-use lib '../blib/lib','../blib/arch';
+use Test::More tests => 33;
 
-END {print "not ok 1\n" unless $loaded;}
-use CGI (':standard','-no_debug','*h3','start_table');
+END { ok $loaded; }
+use CGI ( ':standard', '-no_debug', '*h3', 'start_table' );
 $loaded = 1;
-print "ok 1\n";
+ok 1;
 
 BEGIN {
-   $| = 1; print "1..28\n";
-  if( $] > 5.006 ) {
-    # no utf8
-    require utf8; # we contain Latin-1
-    utf8->unimport;
-  }
+    $| = 1;
+    if ( $] > 5.006 ) {
+
+        # no utf8
+        require utf8;    # we contain Latin-1
+        utf8->unimport;
+    }
 }
 
 ######################### End of black magic.
 
 my $CRLF = "\015\012";
-if ($^O eq 'VMS') { 
-  $CRLF = "\n";  # via web server carriage is inserted automatically
+if ( $^O eq 'VMS' ) {
+    $CRLF = "\n";        # via web server carriage is inserted automatically
 }
-if (ord("\t") != 9) { # EBCDIC?
-  $CRLF = "\r\n";
+if ( ord("\t") != 9 ) {    # EBCDIC?
+    $CRLF = "\r\n";
 }
 
-
 # util
 sub test {
-    local($^W) = 0;
-    my($num, $true,$msg) = @_;
-    print($true ? "ok $num\n" : "not ok $num $msg\n");
+    local ($^W) = 0;
+    my ( undef, $true, $msg ) = @_;
+    ok $true => $msg;
 }
 
 # all the automatic tags
-test(2,h1() eq '<h1 />',"single tag");
-test(3,h1('fred') eq '<h1>fred</h1>',"open/close tag");
-test(4,h1('fred','agnes','maura') eq '<h1>fred agnes maura</h1>',"open/close tag multiple");
-test(5,h1({-align=>'CENTER'},'fred') eq '<h1 align="CENTER">fred</h1>',"open/close tag with attribute");
-test(6,h1({-align=>undef},'fred') eq '<h1 align>fred</h1>',"open/close tag with orphan attribute");
-test(7,h1({-align=>'CENTER'},['fred','agnes']) eq 
-     '<h1 align="CENTER">fred</h1> <h1 align="CENTER">agnes</h1>',
-     "distributive tag with attribute");
+is h1(), '<h1 />', "single tag";
+
+is h1('fred'), '<h1>fred</h1>', "open/close tag";
+
+is h1( 'fred', 'agnes', 'maura' ), '<h1>fred agnes maura</h1>',
+  "open/close tag multiple";
+
+is h1( { -align => 'CENTER' }, 'fred' ), '<h1 align="CENTER">fred</h1>',
+  "open/close tag with attribute";
+
+is h1( { -align => undef }, 'fred' ), '<h1 align>fred</h1>',
+  "open/close tag with orphan attribute";
+
+is h1( { -align => 'CENTER' }, [ 'fred', 'agnes' ] ),
+  '<h1 align="CENTER">fred</h1> <h1 align="CENTER">agnes</h1>',
+  "distributive tag with attribute";
+
 {
-    local($") = '-'; 
-    test(8,h1('fred','agnes','maura') eq '<h1>fred-agnes-maura</h1>',"open/close tag \$\" interpolation");
+    local $" = '-';
+
+    is h1( 'fred', 'agnes', 'maura' ), '<h1>fred-agnes-maura</h1>',
+      "open/close tag \$\" interpolation";
+
 }
-test(9,header() eq "Content-Type: text/html; charset=ISO-8859-1${CRLF}${CRLF}","header()");
-test(10,header(-type=>'image/gif') eq "Content-Type: image/gif${CRLF}${CRLF}","header()");
-test(11,header(-type=>'image/gif',-status=>'500 Sucks') eq "Status: 500 Sucks${CRLF}Content-Type: image/gif${CRLF}${CRLF}","header()");
-test(12,header(-nph=>1) =~ m!HTTP/1.0 200 OK${CRLF}Server: cmdline${CRLF}Date:.+${CRLF}Content-Type: text/html; charset=ISO-8859-1${CRLF}${CRLF}!,"header()");
-test(13,start_html() eq <<END,"start_html()");
+
+is header(), "Content-Type: text/html; charset=ISO-8859-1${CRLF}${CRLF}",
+  "header()";
+
+is header( -type => 'image/gif' ), "Content-Type: image/gif${CRLF}${CRLF}",
+  "header()";
+
+is header( -type => 'image/gif', -status => '500 Sucks' ),
+  "Status: 500 Sucks${CRLF}Content-Type: image/gif${CRLF}${CRLF}", "header()";
+
+like header( -nph => 1 ),
+  qr!HTTP/1.0 200 OK${CRLF}Server: cmdline${CRLF}Date:.+${CRLF}Content-Type: text/html; charset=ISO-8859-1${CRLF}${CRLF}!,
+  "header()";
+
+is start_html(), <<END, "start_html()";
 <!DOCTYPE html
        PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"
         "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
@@ -64,8 +84,8 @@ test(13,start_html() eq <<END,"start_html()");
 </head>
 <body>
 END
-    ;
-test(14,start_html(-Title=>'The world of foo') eq <<END,"start_html()");
+
+is start_html( -Title => 'The world of foo' ), <<END, "start_html()";
 <!DOCTYPE html
        PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"
         "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
@@ -76,38 +96,76 @@ test(14,start_html(-Title=>'The world of foo') eq <<END,"start_html()");
 </head>
 <body>
 END
-    ;
-# Note that this test will turn off XHTML until we make a new CGI object.
-test(15,start_html(-dtd=>"-//IETF//DTD HTML 3.2//FR",-lang=>'fr') eq <<END,"start_html()");
+
+for my $v (qw/ 2.0 3.2 4.0 4.01 /) {
+    local $CGI::XHTML = 1;
+    is
+      start_html( -dtd => "-//IETF//DTD HTML $v//FR", -lang => 'fr' ),
+      <<"END", 'start_html()';
 <!DOCTYPE html
-       PUBLIC "-//IETF//DTD HTML 3.2//FR">
+       PUBLIC "-//IETF//DTD HTML $v//FR">
 <html lang="fr"><head><title>Untitled Document</title>
 </head>
 <body>
 END
-    ;
-test(16,($cookie=cookie(-name=>'fred',-value=>['chocolate','chip'],-path=>'/')) eq 'fred=chocolate&chip; path=/',"cookie()");
-my $h = header(-Cookie=>$cookie);
-test(17,$h =~ m!^Set-Cookie: fred=chocolate&chip\; path=/${CRLF}Date:.*${CRLF}Content-Type: text/html; charset=ISO-8859-1${CRLF}${CRLF}!s, 
-  "header(-cookie)");
-test(18,start_h3 eq '<h3>');
-test(19,end_h3 eq '</h3>');
-test(20,start_table({-border=>undef}) eq '<table border>');
-test(21,h1(escapeHTML("this is <not> \x8bright\x9b")) eq '<h1>this is &lt;not&gt; &#8249;right&#8250;</h1>');
-charset('utf-8');
-if (ord("\t") == 9) {
-test(22,h1(escapeHTML("this is <not> \x8bright\x9b")) eq '<h1>this is &lt;not&gt; �right�</h1>');
-}
-else {
-test(22,h1(escapeHTML("this is <not> \x8bright\x9b")) eq '<h1>this is &lt;not&gt; �right�</h1>');
 }
-test(23,i(p('hello there')) eq '<i><p>hello there</p></i>');
-my $q = new CGI;
-test(24,$q->h1('hi') eq '<h1>hi</h1>');
+
+is
+  start_html( -dtd => "-//IETF//DTD HTML 9.99//FR", -lang => 'fr' ),
+  <<"END", 'start_html()';
+<!DOCTYPE html
+       PUBLIC "-//IETF//DTD HTML 9.99//FR">
+<html xmlns="http://www.w3.org/1999/xhtml" lang="fr" xml:lang="fr">
+<head>
+<title>Untitled Document</title>
+<meta http-equiv="Content-Type" content="text/html; charset=iso-8859-1" />
+</head>
+<body>
+END
+
+my $cookie =
+  cookie( -name => 'fred', -value => [ 'chocolate', 'chip' ], -path => '/' );
+
+is $cookie, 'fred=chocolate&chip; path=/', "cookie()";
+
+my $h = header( -Cookie => $cookie );
+
+like $h,
+  qr!^Set-Cookie: fred=chocolate&chip\; path=/${CRLF}Date:.*${CRLF}Content-Type: text/html; charset=ISO-8859-1${CRLF}${CRLF}!s,
+  "header(-cookie)";
+
+is start_h3, '<h3>';
+
+is end_h3, '</h3>';
+
+is start_table( { -border => undef } ), '<table border>';
+is h1( escapeHTML("this is <not> \x8bright\x9b") ),
+  '<h1>this is &lt;not&gt; &#8249;right&#8250;</h1>';
+
+charset('utf-8');
+
+is h1( escapeHTML("this is <not> \x8bright\x9b") ),
+  ord("\t") == 9
+  ? '<h1>this is &lt;not&gt; �right�</h1>'
+  : '<h1>this is &lt;not&gt; �right�</h1>';
+
+is i( p('hello there') ), '<i><p>hello there</p></i>';
+
+my $q = CGI->new;
+is $q->h1('hi'), '<h1>hi</h1>';
 
 $q->autoEscape(1);
-test(25,$q->p({title=>"hello world&egrave;"},'hello &aacute;') eq '<p title="hello world&amp;egrave;">hello &aacute;</p>');
+
+is $q->p( { title => "hello world&egrave;" }, 'hello &aacute;' ),
+  '<p title="hello world&amp;egrave;">hello &aacute;</p>';
+
 $q->autoEscape(0);
-test(26,$q->p({title=>"hello world&egrave;"},'hello &aacute;') eq '<p title="hello world&egrave;">hello &aacute;</p>');
-test(27,p({title=>"hello world&egrave;"},'hello &aacute;') eq '<p title="hello world&amp;egrave;">hello &aacute;</p>');
-test(28,header(-type=>'image/gif',-charset=>'UTF-8') eq "Content-Type: image/gif; charset=UTF-8${CRLF}${CRLF}","header()");
+
+is $q->p( { title => "hello world&egrave;" }, 'hello &aacute;' ),
+  '<p title="hello world&egrave;">hello &aacute;</p>';
+
+is p( { title => "hello world&egrave;" }, 'hello &aacute;' ),
+  '<p title="hello world&amp;egrave;">hello &aacute;</p>';
+
+is header( -type => 'image/gif', -charset => 'UTF-8' ),
+  "Content-Type: image/gif; charset=UTF-8${CRLF}${CRLF}", "header()";
diff --git a/cpan/CGI/t/http.t b/cpan/CGI/t/http.t
new file mode 100644 (file)
index 0000000..8ca3974
--- /dev/null
@@ -0,0 +1,41 @@
+#!./perl -w
+
+# Fixes RT 12909
+
+use lib qw(t/lib);
+
+use Test::More tests => 7;
+use CGI;
+
+my $cgi = CGI->new();
+
+{
+    # http() without arguments should not cause warnings
+    local $SIG{__WARN__} = sub { die @_ };
+    ok eval { $cgi->http(); 1 },  "http() without arguments doesn't warn";
+    ok eval { $cgi->https(); 1 }, "https() without arguments doesn't warn";
+}
+
+{
+    # Capitalization and the use of hyphens versus underscores are not significant.
+    local $ENV{'HTTP_HOST'}   = 'foo';
+    is $cgi->http('Host'),      'foo', 'http("Host") returns $ENV{HTTP_HOST}';
+    is $cgi->http('http-host'), 'foo', 'http("http-host") returns $ENV{HTTP_HOST}';
+}
+
+{
+    # Called with no arguments returns the list of HTTP environment variables
+    local $ENV{'HTTPS_FOO'} = 'bar';
+    my @http = $cgi->http();
+    is scalar( grep /^HTTPS/, @http), 0, "http() doesn't return HTTPS variables";
+}
+
+{
+    # https()
+    # The same as http(), but operates on the HTTPS environment variables present when the SSL protocol is in
+    # effect.  Can be used to determine whether SSL is turned on.
+    local $ENV{'HTTPS'} = 'ON';
+    local $ENV{'HTTPS_KEYSIZE'} = 512;
+    is $cgi->https(), 'ON', 'scalar context to check SSL is on';
+    ok eq_set( [$cgi->https()], [qw(HTTPS HTTPS_KEYSIZE)]), 'list context returns https keys';
+}
diff --git a/cpan/CGI/t/init.t b/cpan/CGI/t/init.t
new file mode 100644 (file)
index 0000000..532a277
--- /dev/null
@@ -0,0 +1,13 @@
+#!/usr/bin perl -w
+
+use strict;
+use Test::More tests => 1;
+
+use CGI;
+
+
+$_ = "abcdefghijklmnopq";
+my $IN;
+open ($IN, "t/init_test.txt");
+my $q = CGI->new($IN);
+is($_, 'abcdefghijklmnopq', 'make sure not to clobber $_ on init');
diff --git a/cpan/CGI/t/init_test.txt b/cpan/CGI/t/init_test.txt
new file mode 100644 (file)
index 0000000..3101583
--- /dev/null
@@ -0,0 +1,3 @@
+A=B
+D=F
+G=H
index c9a7fb8..66ea21c 100644 (file)
@@ -1,9 +1,5 @@
 #!/usr/local/bin/perl -w
 
-# Due to a bug in older versions of MakeMaker & Test::Harness, we must
-# ensure the blib's are in @INC, else we might use the core CGI.pm
-use lib qw(. ./blib/lib ./blib/arch);
-
 use Test::More tests => 18;
 
 BEGIN { use_ok('CGI'); };
index 3c7d33e..b470b9a 100644 (file)
@@ -1,6 +1,5 @@
 #!perl
 # Tests for popup_menu();
-use lib 't/lib';
 use Test::More 'no_plan';
 use CGI;
 
@@ -11,5 +10,13 @@ is ( $q->popup_menu(-name=>"foo", - values=>[0,1], -default=>0),
 <option selected="selected" value="0">0</option>
 <option value="1">1</option>
 </select>'
-, 'popup_menu(): basic test, including 0 as a default value'); 
+, 'popup_menu(): basic test, including 0 as a default value');
 
+is(
+    CGI::popup_menu(-values=>[CGI::optgroup(-values=>["b+"])],-default=>"b+"),
+    '<select name="" >
+<optgroup label="">
+<option selected="selected" value="b+">b+</option>
+</optgroup>
+</select>'
+    , "<optgroup> selections work when the default values contain regex characters (RT#49606)"); 
index d3c19c0..d6ea67b 100644 (file)
@@ -1,13 +1,8 @@
 #!/bin/perl -w
 
 use strict;
-use lib '.', 't/lib','../blib/lib','./blib/lib';
-use Test::More tests => 18;
-
-BEGIN { use_ok('CGI::Pretty') };
-
-# This is silly use_ok should take arguments
-use CGI::Pretty (':all');
+use Test::More tests => 17;
+use CGI::Pretty ':all';
 
 is(h1(), '<h1 />
 ',"single tag");
@@ -26,8 +21,7 @@ HTML
 
 is(p('hi',pre('there'),'frog'), <<HTML, "<pre> tags");
 <p>
-       hi <pre>there</pre>
-       frog
+       hi <pre>there</pre> frog
 </p>
 HTML
 
@@ -54,8 +48,7 @@ HTML
 
 is(p('hi',a({-href=>'frog'},'there'),'frog'), <<HTML,   "as-is");
 <p>
-       hi <a href="frog">there</a>
-       frog
+       hi <a href="frog">there</a> frog
 </p>
 HTML
 
@@ -100,9 +93,7 @@ is(table(TR(td(table(TR(td( [ qw( hi there frog ) ])))))), <<HTML,   "nested as-
        <tr>
                <td><table>
                        <tr>
-                               <td>hi</td>
-                               <td>there</td>
-                               <td>frog</td>
+                               <td>hi</td><td>there</td><td>frog</td>
                        </tr>
                </table></td>
        </tr>
index 2c48d60..65724a8 100644 (file)
@@ -1,11 +1,5 @@
 #!./perl -wT
 
-use lib qw(t/lib);
-
-# Due to a bug in older versions of MakeMaker & Test::Harness, we must
-# ensure the blib's are in @INC, else we might use the core CGI.pm
-use lib qw(blib/lib blib/arch);
-
 use Test::More tests => 12; 
 
 use_ok( 'CGI::Push' );
index a792232..a7efbe9 100644 (file)
@@ -2,7 +2,6 @@
 
 # Tests for the query_string() method.
 
-use lib 't/lib';
 use Test::More 'no_plan';
 use CGI;
 
index 959986b..5d99536 100644 (file)
@@ -1,24 +1,18 @@
-#!/usr/local/bin/perl -w
+#!/usr/local/bin/perl
 
-# Test ability to retrieve HTTP request info
-######################### We start with some black magic to print on failure.
-use lib '.','../blib/lib','../blib/arch';
+use strict;
+use warnings;
+
+use Test::More tests => 41;
 
-BEGIN {$| = 1; print "1..34\n"; }
-END {print "not ok 1\n" unless $loaded;}
 use CGI ();
 use Config;
-$loaded = 1;
-print "ok 1\n";
 
-######################### End of black magic.
+my $loaded = 1;
 
-# util
-sub test {
-    local($^W) = 0;
-    my($num, $true,$msg) = @_;
-    print($true ? "ok $num\n" : "not ok $num $msg\n");
-}
+$| = 1;
+
+######################### End of black magic.
 
 # Set up a CGI environment
 $ENV{REQUEST_METHOD}  = 'GET';
@@ -32,68 +26,90 @@ $ENV{SERVER_NAME}     = 'the.good.ship.lollypop.com';
 $ENV{REQUEST_URI}     = "$ENV{SCRIPT_NAME}$ENV{PATH_INFO}?$ENV{QUERY_STRING}";
 $ENV{HTTP_LOVE}       = 'true';
 
-$q = new CGI;
-test(2,$q,"CGI::new()");
-test(3,$q->request_method eq 'GET',"CGI::request_method()");
-test(4,$q->query_string eq 'game=chess;game=checkers;weather=dull',"CGI::query_string()");
-test(5,$q->param() == 2,"CGI::param()");
-test(6,join(' ',sort $q->param()) eq 'game weather',"CGI::param()");
-test(7,$q->param('game') eq 'chess',"CGI::param()");
-test(8,$q->param('weather') eq 'dull',"CGI::param()");
-test(9,join(' ',$q->param('game')) eq 'chess checkers',"CGI::param()");
-test(10,$q->param(-name=>'foo',-value=>'bar'),'CGI::param() put');
-test(11,$q->param(-name=>'foo') eq 'bar','CGI::param() get');
-test(12,$q->query_string eq 'game=chess;game=checkers;weather=dull;foo=bar',"CGI::query_string() redux");
-test(13,$q->http('love') eq 'true',"CGI::http()");
-test(14,$q->script_name eq '/cgi-bin/foo.cgi',"CGI::script_name()");
-test(15,$q->url eq 'http://the.good.ship.lollypop.com:8080/cgi-bin/foo.cgi',"CGI::url()");
-test(16,$q->self_url eq 
+my $q = new CGI;
+ok $q,"CGI::new()";
+is $q->request_method => 'GET',"CGI::request_method()";
+is $q->query_string => 'game=chess;game=checkers;weather=dull',"CGI::query_string()";
+is $q->param(), 2,"CGI::param()";
+is join(' ',sort $q->param()), 'game weather',"CGI::param()";
+is $q->param('game'), 'chess',"CGI::param()";
+is $q->param('weather'), 'dull',"CGI::param()";
+is join(' ',$q->param('game')), 'chess checkers',"CGI::param()";
+ok $q->param(-name=>'foo',-value=>'bar'),'CGI::param() put';
+is $q->param(-name=>'foo'), 'bar','CGI::param() get';
+is $q->query_string, 'game=chess;game=checkers;weather=dull;foo=bar',"CGI::query_string() redux";
+is $q->http('love'), 'true',"CGI::http()";
+is $q->script_name, '/cgi-bin/foo.cgi',"CGI::script_name()";
+is $q->url, 'http://the.good.ship.lollypop.com:8080/cgi-bin/foo.cgi',"CGI::url()";
+is $q->self_url,
      'http://the.good.ship.lollypop.com:8080/cgi-bin/foo.cgi/somewhere/else?game=chess;game=checkers;weather=dull;foo=bar',
-     "CGI::url()");
-test(17,$q->url(-absolute=>1) eq '/cgi-bin/foo.cgi','CGI::url(-absolute=>1)');
-test(18,$q->url(-relative=>1) eq 'foo.cgi','CGI::url(-relative=>1)');
-test(19,$q->url(-relative=>1,-path=>1) eq 'foo.cgi/somewhere/else','CGI::url(-relative=>1,-path=>1)');
-test(20,$q->url(-relative=>1,-path=>1,-query=>1) eq 
+     "CGI::url()";
+is $q->url(-absolute=>1), '/cgi-bin/foo.cgi','CGI::url(-absolute=>1)';
+is $q->url(-relative=>1), 'foo.cgi','CGI::url(-relative=>1)';
+is $q->url(-relative=>1,-path=>1), 'foo.cgi/somewhere/else','CGI::url(-relative=>1,-path=>1)';
+is $q->url(-relative=>1,-path=>1,-query=>1), 
      'foo.cgi/somewhere/else?game=chess;game=checkers;weather=dull;foo=bar',
-     'CGI::url(-relative=>1,-path=>1,-query=>1)');
+     'CGI::url(-relative=>1,-path=>1,-query=>1)';
 $q->delete('foo');
-test(21,!$q->param('foo'),'CGI::delete()');
+ok !$q->param('foo'),'CGI::delete()';
 
 $q->_reset_globals;
 $ENV{QUERY_STRING}='mary+had+a+little+lamb';
-test(22,$q=new CGI,"CGI::new() redux");
-test(23,join(' ',$q->keywords) eq 'mary had a little lamb','CGI::keywords');
-test(24,join(' ',$q->param('keywords')) eq 'mary had a little lamb','CGI::keywords');
-test(25,$q=new CGI('foo=bar&foo=baz'),"CGI::new() redux");
-test(26,$q->param('foo') eq 'bar','CGI::param() redux');
-test(27,$q=new CGI({'foo'=>'bar','bar'=>'froz'}),"CGI::new() redux 2");
-test(28,$q->param('bar') eq 'froz',"CGI::param() redux 2");
+ok $q=new CGI,"CGI::new() redux";
+is join(' ',$q->keywords), 'mary had a little lamb','CGI::keywords';
+is join(' ',$q->param('keywords')), 'mary had a little lamb','CGI::keywords';
+ok $q=new CGI('foo=bar&foo=baz'),"CGI::new() redux";
+is $q->param('foo'), 'bar','CGI::param() redux';
+ok $q=new CGI({'foo'=>'bar','bar'=>'froz'}),"CGI::new() redux 2";
+is $q->param('bar'), 'froz',"CGI::param() redux 2";
 
 # test tied interface
 my $p = $q->Vars;
-test(29,$p->{bar} eq 'froz',"tied interface fetch");
+is $p->{bar}, '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});
+is join(' ',$q->param('bar')), 'foo bar baz','tied interface store';
+ok exists $p->{bar};
 
 # test posting
 $q->_reset_globals;
-if ($Config{d_fork}) {
-  $test_string = 'game=soccer&game=baseball&weather=nice';
-  $ENV{REQUEST_METHOD}='POST';
-  $ENV{CONTENT_LENGTH}=length($test_string);
-  $ENV{QUERY_STRING}='big_balls=basketball&small_balls=golf';
-  if (open(CHILD,"|-")) {  # cparent
-    print CHILD $test_string;
-    close CHILD;
-    exit 0;
-  }
-  # at this point, we're in a new (child) process
-  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 32 # Skip\n";
-  print "ok 33 # Skip\n";
-  print "ok 34 # Skip\n";
+{
+  my $test_string = 'game=soccer&game=baseball&weather=nice';
+  local $ENV{REQUEST_METHOD}='POST';
+  local $ENV{CONTENT_LENGTH}=length($test_string);
+  local $ENV{QUERY_STRING}='big_balls=basketball&small_balls=golf';
+
+  local *STDIN;
+  open STDIN, '<', \$test_string;
+
+  ok $q=new CGI,"CGI::new() from POST";
+  is $q->param('weather'), 'nice',"CGI::param() from POST";
+  is $q->url_param('big_balls'), 'basketball',"CGI::url_param()";
+}
+
+# test url_param 
+{
+    local $ENV{QUERY_STRING} = 'game=chess&game=checkers&weather=dull';
+
+    CGI::_reset_globals;
+    my $q = CGI->new;
+    # params present, param and url_param should return true
+    ok $q->param,     'param() is true if parameters';
+    ok $q->url_param, 'url_param() is true if parameters';
+
+    $ENV{QUERY_STRING} = '';
+
+    CGI::_reset_globals;
+    $q = CGI->new;
+    ok !$q->param,     'param() is false if no parameters';
+    ok !$q->url_param, 'url_param() is false if no parameters';
+
+    $ENV{QUERY_STRING} = 'tiger dragon';
+    CGI::_reset_globals;
+    $q = CGI->new;
+
+    is_deeply [$q->$_] => [ 'keywords' ], "$_ with QS='$ENV{QUERY_STRING}'" 
+        for qw/ param url_param /;
+
+    is_deeply [ sort $q->$_( 'keywords' ) ], [ qw/ dragon tiger / ],
+        "$_ keywords" for qw/ param url_param /;
 }
diff --git a/cpan/CGI/t/save_read_roundtrip.t b/cpan/CGI/t/save_read_roundtrip.t
new file mode 100644 (file)
index 0000000..df25077
--- /dev/null
@@ -0,0 +1,24 @@
+
+use strict;
+use warnings;
+
+# Reference: RT#13158: Needs test: empty name/value, when saved, prevents proper restore from filehandle.
+#                      https://rt.cpan.org/Ticket/Display.html?id=13158
+
+use Test::More tests => 3;
+
+use IO::File;
+use CGI;
+
+my $cgi = CGI->new('a=1;=;b=2;=3');
+ok eq_set (['a', '', 'b'], [$cgi->param]);
+
+# not File::Temp, since that wasn't in core at 5.6.0
+my $tmp = IO::File->new_tmpfile;
+$cgi->save($tmp);
+$tmp->seek(0,0);
+
+$cgi = CGI->new($tmp);
+ok eq_set (['a', '', 'b'], [$cgi->param]);
+is $cgi->param(''), 3; # '=' is lost, '=3' is retained
+
index ac58618..25a3325 100644 (file)
@@ -1,11 +1,5 @@
 #!/usr/local/bin/perl -w
 
-use lib qw(t/lib);
-
-# Due to a bug in older versions of MakeMaker & Test::Harness, we must
-# ensure the blib's are in @INC, else we might use the core CGI.pm
-use lib qw(blib/lib blib/arch);
-
 use strict;
 use Test::More tests => 1;
 
index fc0f750..8ae302c 100644 (file)
@@ -1,11 +1,8 @@
-use lib 't/lib';
-use Test::More 'no_plan';
+use Test::More tests => 4;
 use CGI 'unescapeHTML';
 
-is( unescapeHTML( '&amp;'), '&', 'unescapeHTML: &'); 
-is( unescapeHTML( '&quot;'), '"', 'unescapeHTML: "'); 
-TODO: {
-    local $TODO = 'waiting on patch. Reference: https://rt.cpan.org/Ticket/Display.html?id=39122';
-    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( '&amp;'), '&', 'unescapeHTML: &');
+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.');
index 0989f1d..8be37db 100644 (file)
@@ -5,10 +5,6 @@
 #  Shamelessly stolen from Data::FormValidator and CGI::Upload  #
 #################################################################
 
-# Due to a bug in older versions of MakeMaker & Test::Harness, we must
-# ensure the blib's are in @INC, else we might use the core CGI.pm
-use lib qw(. ./blib/lib ./blib/arch);
-
 use strict;
 
 use Test::More 'no_plan';
index 970429b..d68604c 100644 (file)
@@ -5,12 +5,7 @@
 #  Shamelessly stolen from Data::FormValidator and CGI::Upload  #
 #################################################################
 
-# Due to a bug in older versions of MakeMaker & Test::Harness, we must
-# ensure the blib's are in @INC, else we might use the core CGI.pm
-use lib qw(. ./blib/lib ./blib/arch);
-
 use strict;
-
 use Test::More 'no_plan';
 
 use CGI;
index 1a4880d..b861afb 100644 (file)
@@ -1,5 +1,4 @@
 # Test the user_agent method. 
-use lib 't/lib';
 use Test::More 'no_plan';
 use CGI;
 
diff --git a/cpan/CGI/t/utf8.t b/cpan/CGI/t/utf8.t
new file mode 100644 (file)
index 0000000..016dc3b
--- /dev/null
@@ -0,0 +1,34 @@
+#!perl -T
+
+use strict;
+use warnings;
+
+use utf8;
+
+use Test::More tests => 7;
+use Encode;
+
+use_ok( 'CGI' );
+
+ok( my $q = CGI->new, 'create a new CGI object' );
+
+{
+    no warnings qw/ once /;
+    $CGI::PARAM_UTF8 = 1;
+}
+
+my $data = 'áéíóúµ';
+ok Encode::is_utf8($data), "created UTF-8 encoded data string";
+
+# now set the param.
+$q->param(data => $data);
+
+# if param() runs the data  through Encode::decode(), this will fail.
+is $q->param('data'), $data;
+
+# make sure setting bytes decodes properly
+my $bytes = Encode::encode(utf8 => $data);
+ok !Encode::is_utf8($bytes), "converted UTF-8 to bytes";
+$q->param(data => $bytes);
+is $q->param('data'), $data;
+ok Encode::is_utf8($q->param('data')), 'param() decoded UTF-8';
index 75c0ea9..c478d5d 100644 (file)
@@ -10,7 +10,7 @@ is(CGI::Util::escape($uri), "pe%F8%ED%E8ko.ogg", "Escape a Latin-2 string");
 # 2) is a valid utf-8 sequence, but not an UTF-8-flagged string
 #    This happens often: people write utf-8 strings to source, but forget
 #    to tell perl about it by "use utf8;"--this is obviously wrong, but we
-#    have to handle it gracefully, for compatibility with GCI.pm under
+#    have to handle it gracefully, for compatibility with CGI.pm under
 #    perl-5.8.x
 #
 $uri = "pe\x{c5}\x{99}\x{c3}\x{ad}\x{c4}\x{8d}ko.ogg";
index 702a469..787823f 100644 (file)
@@ -2,24 +2,12 @@
 
 # Test ability to escape() and unescape() punctuation characters
 # except for qw(- . _).
-######################### We start with some black magic to print on failure.
-use lib '../blib/lib','../blib/arch';
 
-BEGIN {$| = 1; print "1..57\n"; }
-END {print "not ok 1\n" unless $loaded;}
-use Config;
-use CGI::Util qw(escape unescape);
-$loaded = 1;
-print "ok 1\n";
-
-######################### End of black magic.
+$| = 1;
 
-# util
-sub test {
-    local($^W) = 0;
-    my($num, $true,$msg) = @_;
-    print($true ? "ok $num\n" : "not ok $num $msg\n");
-}
+use Test::More tests => 57;
+use Config;
+use_ok ( 'CGI::Util', qw(escape unescape) );
 
 # ASCII order, ASCII codepoints, ASCII repertoire
 
@@ -42,10 +30,10 @@ foreach(sort(keys(%punct))) {
     $i++;
     my $escape = "AbC\%$punct{$_}dEF";
     my $cgi_escape = escape("AbC$_" . "dEF");
-    test($i, $escape eq $cgi_escape , "# $escape ne $cgi_escape");
+    is($escape, $cgi_escape , "# $escape ne $cgi_escape");
     $i++;
     my $unescape = "AbC$_" . "dEF";
     my $cgi_unescape = unescape("AbC\%$punct{$_}dEF");
-    test($i, $unescape eq $cgi_unescape , "# $unescape ne $cgi_unescape");
+    is($unescape, $cgi_unescape , "# $unescape ne $cgi_unescape");
 }