Upgrade to CGI.pm 3.01

p4raw-id: //depot/perl@21928

7 files changed, 27 insertions, 23 deletions

diff --git a/lib/CGI/Carp.pm b/lib/CGI/Carp.pm
index b99004189d..255b9e758a 100644
--- a/lib/CGI/Carp.pm
+++ b/lib/CGI/Carp.pm
@@ -243,6 +243,8 @@ non-overridden program name
      former isn't working in some people's hands.  There is no such thing
      as reliable exception handling in Perl.
 
+1.27 Replaced tell STDOUT with bytes=tell STDOUT.
+
 =head1 AUTHORS
 
 Copyright 1995-2002, Lincoln D. Stein.  All rights reserved.  
@@ -279,7 +281,7 @@ use File::Spec;
 
 $main::SIG{__WARN__}=\&CGI::Carp::warn;
 
-$CGI::Carp::VERSION    = '1.26';
+$CGI::Carp::VERSION    = '1.27';
 $CGI::Carp::CUSTOM_MSG = undef;
 
 
@@ -490,7 +492,8 @@ END
       $r->custom_response(500,$mess);
     }
   } else {
-    if (eval{tell STDOUT}) {
+    my $bytes_written = eval{tell STDOUT};
+    if (defined $bytes_written && $bytes_written > 0) {
         print STDOUT $mess;
     }
     else {
diff --git a/lib/CGI/Cookie.pm b/lib/CGI/Cookie.pm
index 7060fb4827..27a93c55b0 100644
--- a/lib/CGI/Cookie.pm
+++ b/lib/CGI/Cookie.pm
@@ -220,7 +220,7 @@ sub expires {
 sub max_age {
   my $self = shift;
   my $expires = shift;
-  $self->{'max-age'} = CGI::Util::expire_calc($expires)-time if defined $expires;
+  $self->{'max-age'} = CGI::Util::expire_calc($expires)-time() if defined $expires;
   return $self->{'max-age'};
 }
 
diff --git a/lib/CGI/Fast.pm b/lib/CGI/Fast.pm
index 62e8e662f6..669b38e010 100644
--- a/lib/CGI/Fast.pm
+++ b/lib/CGI/Fast.pm
@@ -16,7 +16,7 @@ package CGI::Fast;
 # The most recent version and complete docs are available at:
 #   http://www.genome.wi.mit.edu/ftp/pub/software/WWW/cgi_docs.html
 #   ftp://ftp-genome.wi.mit.edu/pub/software/WWW/
-$CGI::Fast::VERSION='1.041';
+$CGI::Fast::VERSION='1.04';
 
 use CGI;
 use FCGI;
diff --git a/lib/CGI/Pretty.pm b/lib/CGI/Pretty.pm
index 61aff82256..d824a025e4 100644
--- a/lib/CGI/Pretty.pm
+++ b/lib/CGI/Pretty.pm
@@ -10,7 +10,7 @@ package CGI::Pretty;
 use strict;
 use CGI ();
 
-$CGI::Pretty::VERSION = '1.07_00';
+$CGI::Pretty::VERSION = '1.08';
 $CGI::DefaultClass = __PACKAGE__;
 $CGI::Pretty::AutoloadClass = 'CGI';
 @CGI::Pretty::ISA = qw( CGI );
diff --git a/lib/CGI/Util.pm b/lib/CGI/Util.pm
index e0e7a84228..7c7b08f1f0 100644
--- a/lib/CGI/Util.pm
+++ b/lib/CGI/Util.pm
@@ -4,9 +4,10 @@ use strict;
 use vars qw($VERSION @EXPORT_OK @ISA $EBCDIC @A2E @E2A);
 require Exporter;
 @ISA = qw(Exporter);
-@EXPORT_OK = qw(rearrange make_attributes unescape escape expires);
+@EXPORT_OK = qw(rearrange make_attributes unescape escape 
+		expires ebcdic2ascii ascii2ebcdic);
 
-$VERSION = '1.31';
+$VERSION = '1.3';
 
 $EBCDIC = "\t" ne "\011";
 if ($EBCDIC) {
@@ -268,6 +269,18 @@ sub expire_calc {
     return (time+$offset);
 }
 
+sub ebcdic2ascii {
+  my $data = shift;
+  $data =~ s/(.)/chr $E2A[ord($1)]/ge;
+  $data;
+}
+
+sub ascii2ebcdic {
+  my $data = shift;
+  $data =~ s/(.)/chr $A2E[ord($1)]/ge;
+  $data;
+}
+
 1;
 
 __END__
diff --git a/lib/CGI/t/carp.t b/lib/CGI/t/carp.t
index dcdf732410..6d20a4fe9d 100644
--- a/lib/CGI/t/carp.t
+++ b/lib/CGI/t/carp.t
@@ -8,7 +8,7 @@ use lib qw(t/lib);
 # 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 => 47;
+use Test::More tests => 41;
 use IO::Handle;
 
 BEGIN { use_ok('CGI::Carp') };
@@ -68,7 +68,6 @@ like(stamp2(), $stamp, "Time in correct format");
 # set some variables to control what's going on.
 $CGI::Carp::WARN = 0;
 $CGI::Carp::EMIT_WARNINGS = 0;
-@CGI::Carp::WARNINGS = ();
 my $q_file = quotemeta($file);
 
 
@@ -82,7 +81,6 @@ $expect_l = __LINE__ + 1;
 is(CGI::Carp::warn("There is a problem"),
    "Called realwarn",
    "CGI::Carp::warn calls CORE::warn");
-is(@CGI::Carp::WARNINGS, 0, "_warn not called");
 
 # Test that message is constructed correctly
 eval 'sub CGI::Carp::realwarn {my $mess = shift; return $mess};';
@@ -91,21 +89,15 @@ $expect_l = __LINE__ + 1;
 like(CGI::Carp::warn("There is a problem"),
    "/] $id: There is a problem at $q_file line $expect_l.".'$/',
    "CGI::Carp::warn builds correct message");
-is(@CGI::Carp::WARNINGS, 0, "_warn not called");
 
 # Test that _warn is called at the correct time
 $CGI::Carp::WARN = 1;
 
-$expect_l = __LINE__ + 1;
+my $warn_expect_l = $expect_l = __LINE__ + 1;
 like(CGI::Carp::warn("There is a problem"),
    "/] $id: There is a problem at $q_file line $expect_l.".'$/',
    "CGI::Carp::warn builds correct message");
 
-is(@CGI::Carp::WARNINGS, 1, "_warn now called");
-like($CGI::Carp::WARNINGS[0],
-   "/There is a problem at $q_file line $expect_l.".'$/',
-   "CGI::Carp::WARNINGS has correct message (without stamp)");
-
 #-----------------------------------------------------------------------------
 # Test ineval
 #-----------------------------------------------------------------------------
@@ -180,9 +172,6 @@ is ($CGI::Carp::PROGNAME,undef,"CGI::Carp::set_progname program name unset corre
 
 CGI::Carp::warningsToBrowser(0);
 is($CGI::Carp::EMIT_WARNINGS, 0, "Warnings turned off");
-unless( is(@CGI::Carp::WARNINGS, 1, "_warn not called") ) {
-  print join "\n", map "'$_'", @CGI::Carp::WARNINGS;
-}
 
 # turn off STDOUT (prevents spurious warnings to screen
 tie *STDOUT, 'StoreStuff' or die "Can't tie STDOUT";
@@ -193,11 +182,10 @@ untie *STDOUT;
 open(STDOUT, ">&REAL_STDOUT");
 my $fname = $0;
 $fname =~ tr/<>-/\253\273\255/; # _warn does this so we have to also
-is( $fake_out, "<!-- warning: There is a problem at $fname line 100. -->\n",
+is( $fake_out, "<!-- warning: There is a problem at $fname line $warn_expect_l. -->\n",
                         'warningsToBrowser() on' );
 
 is($CGI::Carp::EMIT_WARNINGS, 1, "Warnings turned off");
-is(@CGI::Carp::WARNINGS, 0, "_warn is called");
 
 #-----------------------------------------------------------------------------
 # Test fatals_to_browser
diff --git a/lib/CGI/t/request.t b/lib/CGI/t/request.t
index 96775a9279..d39619c490 100755
--- a/lib/CGI/t/request.t
+++ b/lib/CGI/t/request.t
@@ -2,7 +2,7 @@
 
 # Test ability to retrieve HTTP request info
 ######################### We start with some black magic to print on failure.
-use lib '../blib/lib','../blib/arch';
+use lib '.','../blib/lib','../blib/arch';
 
 BEGIN {$| = 1; print "1..33\n"; }
 END {print "not ok 1\n" unless $loaded;}