Upgrade to CGI.pm-3.27

p4raw-id: //depot/perl@30486

5 files changed, 93 insertions, 13 deletions

diff --git a/lib/CGI/Carp.pm b/lib/CGI/Carp.pm
index 6f396ca332..bc14d3435d 100644
--- a/lib/CGI/Carp.pm
+++ b/lib/CGI/Carp.pm
@@ -145,6 +145,42 @@ of the error message that caused the script to die.  Example:
 In order to correctly intercept compile-time errors, you should call
 set_message() from within a BEGIN{} block.
 
+=head1 DOING MORE THAN PRINTING A MESSAGE IN THE EVENT OF PERL ERRORS
+
+If fatalsToBrowser in conjunction with set_message does not provide 
+you with all of the functionality you need, you can go one step 
+further by specifying a function to be executed any time a script
+calls "die", has a syntax error, or dies unexpectedly at runtime
+with a line like "undef->explode();". 
+
+    use CGI::Carp qw(set_die_handler);
+    BEGIN {
+       sub handle_errors {
+          my $msg = shift;
+          print "content-type: text/html\n\n";
+          print "<h1>Oh gosh</h1>";
+          print "<p>Got an error: $msg</p>";
+
+          #proceed to send an email to a system administrator,
+          #write a detailed message to the browser and/or a log,
+          #etc....
+      }
+      set_die_handler(\&handle_errors);
+    }
+
+Notice that if you use set_die_handler(), you must handle sending
+HTML headers to the browser yourself if you are printing a message.
+
+If you use set_die_handler(), you will most likely interfere with 
+the behavior of fatalsToBrowser, so you must use this or that, not 
+both. 
+
+Using set_die_handler() sets SIG{__DIE__} (as does fatalsToBrowser),
+and there is only one SIG{__DIE__}. This means that if you are 
+attempting to set SIG{__DIE__} yourself, you may interfere with 
+this module's functionality, or this module may interfere with 
+your module's functionality.
+
 =head1 MAKING WARNINGS APPEAR AS HTML COMMENTS
 
 It is now also possible to make non-fatal errors appear as HTML
@@ -283,12 +319,13 @@ use File::Spec;
 
 @ISA = qw(Exporter);
 @EXPORT = qw(confess croak carp);
-@EXPORT_OK = qw(carpout fatalsToBrowser warningsToBrowser wrap set_message set_progname cluck ^name= die);
+@EXPORT_OK = qw(carpout fatalsToBrowser warningsToBrowser wrap set_message set_die_handler set_progname cluck ^name= die);
 
 $main::SIG{__WARN__}=\&CGI::Carp::warn;
 
-$CGI::Carp::VERSION    = '1.29';
-$CGI::Carp::CUSTOM_MSG = undef;
+$CGI::Carp::VERSION     = '1.29';
+$CGI::Carp::CUSTOM_MSG  = undef;
+$CGI::Carp::DIE_HANDLER = undef;
 
 
 # fancy import routine detects and handles 'errorWrap' specially.
@@ -388,6 +425,10 @@ sub ineval {
 sub die {
   my ($arg,@rest) = @_;
 
+  if ($DIE_HANDLER) {
+      &$DIE_HANDLER($arg,@rest);
+  }
+
   if ( ineval() )  {
     if (!ref($arg)) {
       $arg = join("",($arg,@rest)) || "Died";
@@ -421,6 +462,25 @@ sub set_message {
     return $CGI::Carp::CUSTOM_MSG;
 }
 
+sub set_die_handler {
+
+    my ($handler) = shift;
+    
+    #setting SIG{__DIE__} here is necessary to catch runtime
+    #errors which are not called by literally saying "die",
+    #such as the line "undef->explode();". however, doing this
+    #will interfere with fatalsToBrowser, which also sets 
+    #SIG{__DIE__} in the import() function above (or the 
+    #import() function above may interfere with this). for
+    #this reason, you should choose to either set the die
+    #handler here, or use fatalsToBrowser, not both. 
+    $main::SIG{__DIE__} = $handler;
+    
+    $CGI::Carp::DIE_HANDLER = $handler; 
+    
+    return $CGI::Carp::DIE_HANDLER;
+}
+
 sub confess { CGI::Carp::die Carp::longmess @_; }
 sub croak   { CGI::Carp::die Carp::shortmess @_; }
 sub carp    { CGI::Carp::warn Carp::shortmess @_; }
diff --git a/lib/CGI/Changes b/lib/CGI/Changes
index 23db2a2804..6e656a5077 100644
--- a/lib/CGI/Changes
+++ b/lib/CGI/Changes
@@ -1,6 +1,19 @@
+  Version 3.27
+  1. Applied patch from Steve Taylor that allows checkbox_groups to be
+  disabled with a new -disabled=> option.
+
+  Version 3.26
+  1. Fixed alternate stylesheet behavior so that it is insensitive to order of declarations.
+  2. Patch from John Binns to allow users to provide a callback to CGI::Carp.
+  3. Added "~" as an unreserved character in escape().
+  4. Patch from Chris Fedde to prevent HTTP_HOST from inhibiting SERVER_PORT in url() generation.
+  5. Fixed outdated documentation (and behavior) of -language in start_html -script option.
+  6. Fixed bug in seconds calculation in CGI::Util::expire_calc.
+
   Version 3.25
   1. Fixed the link to the Netscape frames page.
   2. Added ability to specify an alternate stylesheet.
+  3. Add support for XForms POST submssion both as application/xml or as multipart/related
 
   Version 3.24
   1. In startform(), if request_uri() returns undef, then falls back
diff --git a/lib/CGI/Util.pm b/lib/CGI/Util.pm
index b934916f78..9cef416b96 100644
--- a/lib/CGI/Util.pm
+++ b/lib/CGI/Util.pm
@@ -203,9 +203,9 @@ sub escape {
   # force bytes while preserving backward compatibility -- dankogai
   $toencode = pack("C*", unpack("C*", $toencode));
     if ($EBCDIC) {
-      $toencode=~s/([^a-zA-Z0-9_.-])/uc sprintf("%%%02x",$E2A[ord($1)])/eg;
+      $toencode=~s/([^a-zA-Z0-9_.~-])/uc sprintf("%%%02x",$E2A[ord($1)])/eg;
     } else {
-      $toencode=~s/([^a-zA-Z0-9_.-])/uc sprintf("%%%02x",ord($1))/eg;
+      $toencode=~s/([^a-zA-Z0-9_.~-])/uc sprintf("%%%02x",ord($1))/eg;
     }
   return $toencode;
 }
@@ -258,13 +258,13 @@ sub expire_calc {
     # specifying the date yourself
     my($offset);
     if (!$time || (lc($time) eq 'now')) {
-        $offset = 0;
+      $offset = 0;
     } elsif ($time=~/^\d+/) {
-        return $time;
-    } elsif ($time=~/^([+-]?(?:\d+|\d*\.\d*))([mhdMy])/) {
-        $offset = ($mult{$2} || 1)*$1;
+      return $time;
+    } elsif ($time=~/^([+-]?(?:\d+|\d*\.\d*))([smhdMy])/) {
+      $offset = ($mult{$2} || 1)*$1;
     } else {
-        return $time;
+      return $time;
     }
     return (time+$offset);
 }
diff --git a/lib/CGI/t/form.t b/lib/CGI/t/form.t
index 54b3792789..dea0046eb2 100755
--- a/lib/CGI/t/form.t
+++ b/lib/CGI/t/form.t
@@ -4,7 +4,7 @@
 # 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;
+use Test::More tests => 19;
 
 BEGIN { use_ok('CGI'); };
 use CGI (':standard','-no_debug','-tabindex');
@@ -127,3 +127,10 @@ is(scrolling_list(-name => 'game',
 <option selected="selected" value="cribbage">cribbage</option>
 </select>',
   'scrolling_list()');
+
+is(checkbox_group(-name   => 'game',
+		  -Values => [qw/checkers chess cribbage/],
+		 -disabled => ['checkers']),
+   qq(<label><input type="checkbox" name="game" value="checkers" checked="checked" tabindex="23" disabled='1'/><span style="color:gray">checkers</span></label> <label><input type="checkbox" name="game" value="chess" checked="checked" tabindex="24" />chess</label> <label><input type="checkbox" name="game" value="cribbage" tabindex="25" />cribbage</label>),
+   'checkbox_group()');
+
diff --git a/lib/CGI/t/util.t b/lib/CGI/t/util.t
index 8f9da3ba94..702a4695d6 100644
--- a/lib/CGI/t/util.t
+++ b/lib/CGI/t/util.t
@@ -5,7 +5,7 @@
 ######################### We start with some black magic to print on failure.
 use lib '../blib/lib','../blib/arch';
 
-BEGIN {$| = 1; print "1..59\n"; }
+BEGIN {$| = 1; print "1..57\n"; }
 END {print "not ok 1\n" unless $loaded;}
 use Config;
 use CGI::Util qw(escape unescape);
@@ -31,7 +31,7 @@ my %punct = (
     ':' => '3A',  ';' => '3B',  '<' => '3C',  '=' =>  '3D', 
     '>' => '3E',  '?' => '3F',  '[' => '5B',  '\\' => '5C', 
     ']' => '5D',  '^' => '5E',                '`' =>  '60',  # '_' => '5F',
-    '{' => '7B',  '|' => '7C',  '}' => '7D',  '~' =>  '7E', 
+    '{' => '7B',  '|' => '7C',  '}' => '7D',  # '~' =>  '7E', 
          );
 
 # The sort order may not be ASCII on EBCDIC machines: