projects / p5sagit/p5-mst-13.2.git / commitdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw (from parent 1: 31f2a39)
Update to CGI.pm 2.78.
Jarkko Hietaniemi [Tue, 6 Nov 2001 22:12:28 +0000 (22:12 +0000)]
TODO: the test suite needs to be merged so that
when in core, the core version is tested, and when
using the CPAN version, testing the CPAN version.
(the changes need to be sent to Lincoln, too...)

p4raw-id: //depot/perl@12876

19 files changed:
lib/CGI.pm patch | blob | blame | history
lib/CGI/Apache.pm patch | blob | blame | history
lib/CGI/Carp.pm patch | blob | blame | history
lib/CGI/Cookie.pm patch | blob | blame | history
lib/CGI/Pretty.pm patch | blob | blame | history
lib/CGI/Switch.pm patch | blob | blame | history
lib/CGI/Util.pm patch | blob | blame | history
lib/CGI/t/apache.t patch | blob | blame | history
lib/CGI/t/carp.t patch | blob | blame | history
lib/CGI/t/cookie.t patch | blob | blame | history
lib/CGI/t/fast.t patch | blob | blame | history
lib/CGI/t/form.t patch | blob | blame | history
lib/CGI/t/function.t patch | blob | blame | history
lib/CGI/t/html.t patch | blob | blame | history
lib/CGI/t/pretty.t patch | blob | blame | history
lib/CGI/t/push.t patch | blob | blame | history
lib/CGI/t/request.t patch | blob | blame | history
lib/CGI/t/switch.t patch | blob | blame | history
lib/CGI/t/util.t patch | blob | blame | history

diff --git a/lib/CGI.pm b/lib/CGI.pm
index 3e8ed35..0be5060 100644 (file)
--- a/lib/CGI.pm
+++ b/lib/CGI.pm
@@ -18,12 +18,12 @@ use Carp 'croak';
 # The most recent version and complete docs are available at:
 #   http://stein.cshl.org/WWW/software/CGI/
 
-$CGI::revision = '$Id: CGI.pm,v 1.51 2001/08/07 12:28:43 lstein Exp $';
-$CGI::VERSION='2.77';
+$CGI::revision = '$Id: CGI.pm,v 1.55 2001/09/26 02:15:52 lstein Exp $';
+$CGI::VERSION='2.78';
 
 # HARD-CODED LOCATION FOR FILE UPLOAD TEMPORARY FILES.
 # UNCOMMENT THIS ONLY IF YOU KNOW WHAT YOU'RE DOING.
-# $TempFile::TMPDIRECTORY = '/usr/tmp';
+# $CGITempFile::TMPDIRECTORY = '/usr/tmp';
 use CGI::Util qw(rearrange make_attributes unescape escape expires);
 
 use constant XHTML_DTD => ['-//W3C//DTD XHTML Basic 1.0//EN',
@@ -140,8 +140,8 @@ $AutoloadClass = $DefaultClass unless defined $CGI::AutoloadClass;
 # The path separator is a slash, backslash or semicolon, depending
 # on the paltform.
 $SL = {
-    UNIX=>'/', OS2=>'\\', EPOC=>'/', 
-    WINDOWS=>'\\', DOS=>'\\', MACINTOSH=>':', VMS=>'/'
+       UNIX=>'/', OS2=>'\\', EPOC=>'/',
+       WINDOWS=>'\\', DOS=>'\\', MACINTOSH=>':', VMS=>'/'
     }->{$OS};
 
 # This no longer seems to be necessary
@@ -1307,8 +1307,11 @@ END_OF_FUNC
 'start_html' => <<'END_OF_FUNC',
 sub start_html {
     my($self,@p) = &self_or_default(@_);
-    my($title,$author,$base,$xbase,$script,$noscript,$target,$meta,$head,$style,$dtd,$lang,@other) = 
-       rearrange([TITLE,AUTHOR,BASE,XBASE,SCRIPT,NOSCRIPT,TARGET,META,HEAD,STYLE,DTD,LANG],@p);
+    my($title,$author,$base,$xbase,$script,$noscript,
+        $target,$meta,$head,$style,$dtd,$lang,$encoding,@other) = 
+       rearrange([TITLE,AUTHOR,BASE,XBASE,SCRIPT,NOSCRIPT,TARGET,META,HEAD,STYLE,DTD,LANG,ENCODING],@p);
+
+    $encoding = 'utf-8' unless defined $encoding;
 
     # strangely enough, the title needs to be escaped as HTML
     # while the author needs to be escaped as a URL
@@ -1328,7 +1331,7 @@ sub start_html {
 
     $xml_dtd++ if ref($dtd) eq 'ARRAY' && $dtd->[0] =~ /\bXHTML\b/i;
     $xml_dtd++ if ref($dtd) eq '' && $dtd =~ /\bXHTML\b/i;
-    push @result,q(<?xml version="1.0" encoding="utf-8"?>) if $xml_dtd; 
+    push @result,qq(<?xml version="1.0" encoding="$encoding"?>) if $xml_dtd; 
 
     if (ref($dtd) && ref($dtd) eq 'ARRAY') {
         push(@result,qq(<!DOCTYPE html\n\tPUBLIC "$dtd->[0]"\n\t"$dtd->[1]">));
@@ -1819,9 +1822,9 @@ sub checkbox {
 
     if (!$override && ($self->{'.fieldnames'}->{$name} || 
                       defined $self->param($name))) {
-       $checked = grep($_ eq $value,$self->param($name)) ? ' checked' : '';
+       $checked = grep($_ eq $value,$self->param($name)) ? ' checked="1"' : '';
     } else {
-       $checked = $checked ? qq/ checked/ : '';
+       $checked = $checked ? qq/ checked="1"/ : '';
     }
     my($the_label) = defined $label ? $label : $name;
     $name = $self->escapeHTML($name);
@@ -1886,7 +1889,7 @@ sub checkbox_group {
 
     my($other) = @other ? " @other" : '';
     foreach (@values) {
-       $checked = $checked{$_} ? qq/ checked/ : '';
+       $checked = $checked{$_} ? qq/ checked="1"/ : '';
        $label = '';
        unless (defined($nolabels) && $nolabels) {
            $label = $_;
@@ -1907,6 +1910,8 @@ END_OF_FUNC
 # Escape HTML -- used internally
 '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->{'dontescape'};
@@ -2032,7 +2037,7 @@ sub radio_group {
 
     my($other) = @other ? " @other" : '';
     foreach (@values) {
-       my($checkit) = $checked eq $_ ? qq/ checked/ : '';
+       my($checkit) = $checked eq $_ ? qq/ checked="1"/ : '';
        my($break);
        if ($linebreak) {
           $break = $XHTML ? "<br />" : "<br>";
@@ -2093,7 +2098,7 @@ sub popup_menu {
 
     $result = qq/<select name="$name"$other>\n/;
     foreach (@values) {
-       my($selectit) = defined($selected) ? ($selected eq $_ ? qq/selected/ : '' ) : '';
+       my($selectit) = defined($selected) ? ($selected eq $_ ? qq/selected="1"/ : '' ) : '';
        my($label) = $_;
        $label = $labels->{$_} if defined($labels) && defined($labels->{$_});
        my($value) = $self->escapeHTML($_);
@@ -2140,14 +2145,14 @@ sub scrolling_list {
     $size = $size || scalar(@values);
 
     my(%selected) = $self->previous_or_default($name,$defaults,$override);
-    my($is_multiple) = $multiple ? qq/ multiple/ : '';
+    my($is_multiple) = $multiple ? qq/ multiple="multiple"/ : '';
     my($has_size) = $size ? qq/ size="$size"/: '';
     my($other) = @other ? " @other" : '';
 
     $name=$self->escapeHTML($name);
     $result = qq/<select name="$name"$has_size$is_multiple$other>\n/;
     foreach (@values) {
-       my($selectit) = $selected{$_} ? qq/selected/ : '';
+       my($selectit) = $selected{$_} ? qq/selected="1"/ : '';
        my($label) = $_;
        $label = $labels->{$_} if defined($labels) && defined($labels->{$_});
        $label=$self->escapeHTML($label);
@@ -2220,7 +2225,7 @@ sub image_button {
     my($name,$src,$alignment,@other) =
        rearrange([NAME,SRC,ALIGN],@p);
 
-    my($align) = $alignment ? " align=\U$alignment" : '';
+    my($align) = $alignment ? " align=\U\"$alignment\"" : '';
     my($other) = @other ? " @other" : '';
     $name=$self->escapeHTML($name);
     return $XHTML ? qq(<input type="image" name="$name" src="$src"$align$other />)
@@ -2911,7 +2916,7 @@ sub read_multipart {
          # choose a relatively unpredictable tmpfile sequence number
           my $seqno = unpack("%16C*",join('',localtime,values %ENV));
           for (my $cnt=10;$cnt>0;$cnt--) {
-           next unless $tmpfile = new TempFile($seqno);
+           next unless $tmpfile = new CGITempFile($seqno);
            $tmp = $tmpfile->as_string;
            last if defined($filehandle = Fh->new($filename,$tmp,$PRIVATE_TEMPFILES));
             $seqno += int rand(100);
@@ -3249,7 +3254,8 @@ sub read {
     substr($self->{BUFFER},0,$bytesToReturn)='';
     
     # If we hit the boundary, remove the CRLF from the end.
-    return ($start > 0) ? substr($returnval,0,-2) : $returnval;
+    return (($start > 0) && ($start <= $bytes)) 
+           ? substr($returnval,0,-2) : $returnval;
 }
 END_OF_FUNC
 
@@ -3306,7 +3312,7 @@ END_OF_AUTOLOAD
 ####################################################################################
 ################################## TEMPORARY FILES #################################
 ####################################################################################
-package TempFile;
+package CGITempFile;
 
 $SL = $CGI::SL;
 $MAC = $CGI::OS eq 'MACINTOSH';
@@ -3338,7 +3344,7 @@ $MAXTRIES = 5000;
 
 # cute feature, but overload implementation broke it
 # %OVERLOAD = ('""'=>'as_string');
-*TempFile::AUTOLOAD = \&CGI::AUTOLOAD;
+*CGITempFile::AUTOLOAD = \&CGI::AUTOLOAD;
 
 ###############################################################################
 ################# THESE FUNCTIONS ARE AUTOLOADED ON DEMAND ####################
@@ -4396,6 +4402,9 @@ English.  For example:
 
     print $q->start_html(-lang=>'fr-CA');
 
+The B<-encoding> argument can be used to specify the character set for
+XHTML.  It defaults to UTF-8 if not specified.
+
 You can place other arbitrary HTML elements to the <HEAD> section with the
 B<-head> tag.  For example, to place the rarely-used <LINK> element in the
 head section, use this:
@@ -5463,7 +5472,7 @@ of the particular button clicked on using the "this" variable.
 =head2 CREATING A STANDALONE CHECKBOX
 
     print $query->checkbox(-name=>'checkbox_name',
-                          -checked=>'checked',
+                          -checked=>1,
                           -value=>'ON',
                           -label=>'CLICK ME');
 
@@ -5731,7 +5740,6 @@ field.
 The second argument (-src) is also required and specifies the URL
 
 =item 3.
-
 The third option (-align, optional) is an alignment type, and may be
 TOP, BOTTOM or MIDDLE
 
@@ -6165,7 +6173,6 @@ Returns either the remote host name or IP address.
 if the former is unavailable.
 
 =item B<script_name()>
-
 Return the script name as a partial URL, for self-refering
 scripts.
 
diff --git a/lib/CGI/Apache.pm b/lib/CGI/Apache.pm
index 550c6e4..c711a48 100644 (file)
--- a/lib/CGI/Apache.pm
+++ b/lib/CGI/Apache.pm
@@ -1,6 +1,6 @@
 use CGI;
 
-our $VERSION = '1.00';
+$VERSION = '1.00';
 
 1;
 __END__
diff --git a/lib/CGI/Carp.pm b/lib/CGI/Carp.pm
index 2829e22..317fdf8 100644 (file)
--- a/lib/CGI/Carp.pm
+++ b/lib/CGI/Carp.pm
@@ -226,7 +226,7 @@ use File::Spec;
 
 $main::SIG{__WARN__}=\&CGI::Carp::warn;
 $main::SIG{__DIE__}=\&CGI::Carp::die;
-$CGI::Carp::VERSION = '1.20';
+$CGI::Carp::VERSION = '1.21';
 $CGI::Carp::CUSTOM_MSG = undef;
 
 # fancy import routine detects and handles 'errorWrap' specially.
@@ -256,7 +256,7 @@ sub id {
 sub stamp {
     my $time = scalar(localtime);
     my $frame = 0;
-     my ($id,$pack,$file,$dev,$dirs);
+    my ($id,$pack,$file,$dev,$dirs);
     do {
        $id = $file;
        ($pack,$file) = caller($frame++);
@@ -289,7 +289,7 @@ sub _warn {
     }
 }
 
-sub ineval { _longmess() =~ /eval [\{\']/m }
+sub ineval { $^S }
 
 # The mod_perl package Apache::Registry loads CGI programs by calling
 # eval.  These evals don't count when looking at the stack backtrace.
diff --git a/lib/CGI/Cookie.pm b/lib/CGI/Cookie.pm
index 905ef5e..1e1cfde 100644 (file)
--- a/lib/CGI/Cookie.pm
+++ b/lib/CGI/Cookie.pm
@@ -153,7 +153,19 @@ sub name {
 sub value {
     my $self = shift;
     my $value = shift;
-    $self->{'value'} = $value if defined $value;
+      if (defined $value) {
+              my @values;
+        if (ref($value)) {
+            if (ref($value) eq 'ARRAY') {
+                @values = @$value;
+            } elsif (ref($value) eq 'HASH') {
+                @values = %$value;
+            }
+        } else {
+            @values = ($value);
+        }
+      $self->{'value'} = [@values];
+      }
     return wantarray ? @{$self->{'value'}} : $self->{'value'}->[0]
 }
 
diff --git a/lib/CGI/Pretty.pm b/lib/CGI/Pretty.pm
index fe2f07f..ef606e9 100644 (file)
--- a/lib/CGI/Pretty.pm
+++ b/lib/CGI/Pretty.pm
@@ -84,6 +84,16 @@ sub _make_tag_func {
                 (ref(\$_[0]) eq 'ARRAY') ? \@{\$_[0]} : "\@_";
            }
            else {
+                my \@args;
+               if(ref(\$_[0]) eq 'ARRAY') {
+                    \@args = \@{\$_[0]}
+                } else {
+                    foreach (\@_) {
+                        \$args[0] .= \$_;
+                        \$args[0] .= " " unless \$args[0] =~ /\\s\$/;
+                    }
+                    chop \$args[0];
+                }
                \@result = map { 
                    chomp; 
                    if ( \$_ !~ /<\\// ) {
@@ -94,8 +104,8 @@ sub _make_tag_func {
                        CGI::Pretty::_prettyPrint( \\\$tmp );
                        \$_ = \$tmp;
                    }
-                   "\$tag\$CGI::Pretty::LINEBREAK\$CGI::Pretty::INDENT\$_\$CGI::Pretty::LINEBREAK\$untag\$CGI::Pretty::LINEBREAK" } 
-               (ref(\$_[0]) eq 'ARRAY') ? \@{\$_[0]} : "\@_";
+                   "\$tag\$CGI::Pretty::LINEBREAK\$CGI::Pretty::INDENT\$_\$CGI::Pretty::LINEBREAK\$untag\$CGI::Pretty::LINEBREAK" 
+                } \@args;
            }
            local \$" = "";
            return "\@result";
diff --git a/lib/CGI/Switch.pm b/lib/CGI/Switch.pm
index e754fde..b8cc9ef 100644 (file)
--- a/lib/CGI/Switch.pm
+++ b/lib/CGI/Switch.pm
@@ -1,6 +1,6 @@
 use CGI;
 
-our $VERSION = '1.00';
+$VERSION = '1.00';
 
 1;
 
diff --git a/lib/CGI/Util.pm b/lib/CGI/Util.pm
index 2b48ff2..72d6754 100644 (file)
--- a/lib/CGI/Util.pm
+++ b/lib/CGI/Util.pm
@@ -1,72 +1,72 @@
 package CGI::Util;
 
 use strict;
-use vars '$VERSION','@EXPORT_OK','@ISA','$EBCDIC','@A2E','@E2A';
+use vars qw($VERSION @EXPORT_OK @ISA $EBCDIC @A2E @E2A);
 require Exporter;
 @ISA = qw(Exporter);
 @EXPORT_OK = qw(rearrange make_attributes unescape escape expires);
 
-$VERSION = '1.1';
+$VERSION = '1.3';
 
 $EBCDIC = "\t" ne "\011";
 if ($EBCDIC) {
-# (ord('^') == 95) for codepage 1047 as on os390, vmesa
-@A2E = (
-  0,  1,  2,  3, 55, 45, 46, 47, 22,  5, 21, 11, 12, 13, 14, 15,
- 16, 17, 18, 19, 60, 61, 50, 38, 24, 25, 63, 39, 28, 29, 30, 31,
- 64, 90,127,123, 91,108, 80,125, 77, 93, 92, 78,107, 96, 75, 97,
-240,241,242,243,244,245,246,247,248,249,122, 94, 76,126,110,111,
-124,193,194,195,196,197,198,199,200,201,209,210,211,212,213,214,
-215,216,217,226,227,228,229,230,231,232,233,173,224,189, 95,109,
-121,129,130,131,132,133,134,135,136,137,145,146,147,148,149,150,
-151,152,153,162,163,164,165,166,167,168,169,192, 79,208,161,  7,
- 32, 33, 34, 35, 36, 37,  6, 23, 40, 41, 42, 43, 44,  9, 10, 27,
- 48, 49, 26, 51, 52, 53, 54,  8, 56, 57, 58, 59,  4, 20, 62,255,
- 65,170, 74,177,159,178,106,181,187,180,154,138,176,202,175,188,
-144,143,234,250,190,160,182,179,157,218,155,139,183,184,185,171,
-100,101, 98,102, 99,103,158,104,116,113,114,115,120,117,118,119,
-172,105,237,238,235,239,236,191,128,253,254,251,252,186,174, 89,
- 68, 69, 66, 70, 67, 71,156, 72, 84, 81, 82, 83, 88, 85, 86, 87,
-140, 73,205,206,203,207,204,225,112,221,222,219,220,141,142,223
-      );
-@E2A = (
-  0,  1,  2,  3,156,  9,134,127,151,141,142, 11, 12, 13, 14, 15,
- 16, 17, 18, 19,157, 10,  8,135, 24, 25,146,143, 28, 29, 30, 31,
-128,129,130,131,132,133, 23, 27,136,137,138,139,140,  5,  6,  7,
-144,145, 22,147,148,149,150,  4,152,153,154,155, 20, 21,158, 26,
- 32,160,226,228,224,225,227,229,231,241,162, 46, 60, 40, 43,124,
- 38,233,234,235,232,237,238,239,236,223, 33, 36, 42, 41, 59, 94,
- 45, 47,194,196,192,193,195,197,199,209,166, 44, 37, 95, 62, 63,
-248,201,202,203,200,205,206,207,204, 96, 58, 35, 64, 39, 61, 34,
-216, 97, 98, 99,100,101,102,103,104,105,171,187,240,253,254,177,
-176,106,107,108,109,110,111,112,113,114,170,186,230,184,198,164,
-181,126,115,116,117,118,119,120,121,122,161,191,208, 91,222,174,
-172,163,165,183,169,167,182,188,189,190,221,168,175, 93,180,215,
-123, 65, 66, 67, 68, 69, 70, 71, 72, 73,173,244,246,242,243,245,
-125, 74, 75, 76, 77, 78, 79, 80, 81, 82,185,251,252,249,250,255,
- 92,247, 83, 84, 85, 86, 87, 88, 89, 90,178,212,214,210,211,213,
- 48, 49, 50, 51, 52, 53, 54, 55, 56, 57,179,219,220,217,218,159
-      );
-if (ord('^') == 106) { # as in the BS2000 posix-bc coded character set
-    $A2E[91] = 187;   $A2E[92] = 188;  $A2E[94] = 106;  $A2E[96] = 74;
-    $A2E[123] = 251;  $A2E[125] = 253; $A2E[126] = 255; $A2E[159] = 95;
-    $A2E[162] = 176;  $A2E[166] = 208; $A2E[168] = 121; $A2E[172] = 186;
-    $A2E[175] = 161;  $A2E[217] = 224; $A2E[219] = 221; $A2E[221] = 173;
-    $A2E[249] = 192;
-
-    $E2A[74] = 96;   $E2A[95] = 159;  $E2A[106] = 94;  $E2A[121] = 168;
-    $E2A[161] = 175; $E2A[173] = 221; $E2A[176] = 162; $E2A[186] = 172;
-    $E2A[187] = 91;  $E2A[188] = 92;  $E2A[192] = 249; $E2A[208] = 166;
-    $E2A[221] = 219; $E2A[224] = 217; $E2A[251] = 123; $E2A[253] = 125;
-    $E2A[255] = 126;
-}
-elsif (ord('^') == 176) { # as in codepage 037 on os400
-    $A2E[10] = 37;  $A2E[91] = 186;  $A2E[93] = 187; $A2E[94] = 176;
-    $A2E[133] = 21; $A2E[168] = 189; $A2E[172] = 95; $A2E[221] = 173;
-
-    $E2A[21] = 133; $E2A[37] = 10;  $E2A[95] = 172; $E2A[173] = 221;
-    $E2A[176] = 94; $E2A[186] = 91; $E2A[187] = 93; $E2A[189] = 168;
-}
+  # (ord('^') == 95) for codepage 1047 as on os390, vmesa
+  @A2E = (
+   0,  1,  2,  3, 55, 45, 46, 47, 22,  5, 21, 11, 12, 13, 14, 15,
+  16, 17, 18, 19, 60, 61, 50, 38, 24, 25, 63, 39, 28, 29, 30, 31,
+  64, 90,127,123, 91,108, 80,125, 77, 93, 92, 78,107, 96, 75, 97,
+ 240,241,242,243,244,245,246,247,248,249,122, 94, 76,126,110,111,
+ 124,193,194,195,196,197,198,199,200,201,209,210,211,212,213,214,
+ 215,216,217,226,227,228,229,230,231,232,233,173,224,189, 95,109,
+ 121,129,130,131,132,133,134,135,136,137,145,146,147,148,149,150,
+ 151,152,153,162,163,164,165,166,167,168,169,192, 79,208,161,  7,
+  32, 33, 34, 35, 36, 37,  6, 23, 40, 41, 42, 43, 44,  9, 10, 27,
+  48, 49, 26, 51, 52, 53, 54,  8, 56, 57, 58, 59,  4, 20, 62,255,
+  65,170, 74,177,159,178,106,181,187,180,154,138,176,202,175,188,
+ 144,143,234,250,190,160,182,179,157,218,155,139,183,184,185,171,
+ 100,101, 98,102, 99,103,158,104,116,113,114,115,120,117,118,119,
+ 172,105,237,238,235,239,236,191,128,253,254,251,252,186,174, 89,
+  68, 69, 66, 70, 67, 71,156, 72, 84, 81, 82, 83, 88, 85, 86, 87,
+ 140, 73,205,206,203,207,204,225,112,221,222,219,220,141,142,223
+        );
+  @E2A = (
+   0,  1,  2,  3,156,  9,134,127,151,141,142, 11, 12, 13, 14, 15,
+  16, 17, 18, 19,157, 10,  8,135, 24, 25,146,143, 28, 29, 30, 31,
+ 128,129,130,131,132,133, 23, 27,136,137,138,139,140,  5,  6,  7,
+ 144,145, 22,147,148,149,150,  4,152,153,154,155, 20, 21,158, 26,
+  32,160,226,228,224,225,227,229,231,241,162, 46, 60, 40, 43,124,
+  38,233,234,235,232,237,238,239,236,223, 33, 36, 42, 41, 59, 94,
+  45, 47,194,196,192,193,195,197,199,209,166, 44, 37, 95, 62, 63,
+ 248,201,202,203,200,205,206,207,204, 96, 58, 35, 64, 39, 61, 34,
+ 216, 97, 98, 99,100,101,102,103,104,105,171,187,240,253,254,177,
+ 176,106,107,108,109,110,111,112,113,114,170,186,230,184,198,164,
+ 181,126,115,116,117,118,119,120,121,122,161,191,208, 91,222,174,
+ 172,163,165,183,169,167,182,188,189,190,221,168,175, 93,180,215,
+ 123, 65, 66, 67, 68, 69, 70, 71, 72, 73,173,244,246,242,243,245,
+ 125, 74, 75, 76, 77, 78, 79, 80, 81, 82,185,251,252,249,250,255,
+  92,247, 83, 84, 85, 86, 87, 88, 89, 90,178,212,214,210,211,213,
+  48, 49, 50, 51, 52, 53, 54, 55, 56, 57,179,219,220,217,218,159
+        );
+  if (ord('^') == 106) { # as in the BS2000 posix-bc coded character set
+     $A2E[91] = 187;   $A2E[92] = 188;  $A2E[94] = 106;  $A2E[96] = 74;
+     $A2E[123] = 251;  $A2E[125] = 253; $A2E[126] = 255; $A2E[159] = 95;
+     $A2E[162] = 176;  $A2E[166] = 208; $A2E[168] = 121; $A2E[172] = 186;
+     $A2E[175] = 161;  $A2E[217] = 224; $A2E[219] = 221; $A2E[221] = 173;
+     $A2E[249] = 192;
+ 
+     $E2A[74] = 96;   $E2A[95] = 159;  $E2A[106] = 94;  $E2A[121] = 168;
+     $E2A[161] = 175; $E2A[173] = 221; $E2A[176] = 162; $E2A[186] = 172;
+     $E2A[187] = 91;  $E2A[188] = 92;  $E2A[192] = 249; $E2A[208] = 166;
+     $E2A[221] = 219; $E2A[224] = 217; $E2A[251] = 123; $E2A[253] = 125;
+     $E2A[255] = 126;
+ }
+  elsif (ord('^') == 176) { # as in codepage 037 on os400
+     $A2E[10] = 37;  $A2E[91] = 186;  $A2E[93] = 187; $A2E[94] = 176;
+     $A2E[133] = 21; $A2E[168] = 189; $A2E[172] = 95; $A2E[221] = 173;
+ 
+     $E2A[21] = 133; $E2A[37] = 10;  $E2A[95] = 172; $E2A[173] = 221;
+     $E2A[176] = 94; $E2A[186] = 91; $E2A[187] = 93; $E2A[189] = 168;
+   }
 }
 
 # Smart rearrangement of parameters to allow named parameter
@@ -180,7 +180,7 @@ sub utf8_chr ($) {
 
 # unescape URL-encoded data
 sub unescape {
-  shift() if ref($_[0]) || (defined $_[1] && $_[0] eq $CGI::DefaultClass);
+  shift() if @_ > 1 and (ref($_[0]) || (defined $_[1] && $_[0] eq $CGI::DefaultClass));
   my $todecode = shift;
   return undef unless defined($todecode);
   $todecode =~ tr/+/ /;       # pluses become spaces
@@ -196,7 +196,7 @@ sub unescape {
 
 # URL-encode data
 sub escape {
-  shift() if ref($_[0]) || (defined $_[1] && $_[0] eq $CGI::DefaultClass);
+  shift() if @_ > 1 and ( ref($_[0]) || (defined $_[1] && $_[0] eq $CGI::DefaultClass));
   my $toencode = shift;
   return undef unless defined($toencode);
     if ($EBCDIC) {
diff --git a/lib/CGI/t/apache.t b/lib/CGI/t/apache.t
index 2725bbe..7f92155 100644 (file)
--- a/lib/CGI/t/apache.t
+++ b/lib/CGI/t/apache.t
@@ -1,7 +1,13 @@
 #!/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;
 
 # Can't do much with this other than make sure it loads properly
-BEGIN { use_ok('CGI::Apache') };
\ No newline at end of file
+BEGIN { use_ok('CGI::Apache') };
diff --git a/lib/CGI/t/carp.t b/lib/CGI/t/carp.t
index 1eebef9..9bf5465 100644 (file)
--- a/lib/CGI/t/carp.t
+++ b/lib/CGI/t/carp.t
@@ -1,13 +1,13 @@
 # -*- Mode: cperl; coding: utf-8; cperl-indent-level: 2 -*-
 #!/usr/local/bin/perl -w
 
-BEGIN {
-    chdir 't' if -d 't';
-    @INC = '../lib';
-}
-
 use strict;
-#use lib qw(t/lib);
+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 => 42;
 use IO::Handle;
 
@@ -96,7 +96,7 @@ is(@CGI::Carp::WARNINGS, 0, "_warn not called");
 # Test that _warn is called at the correct time
 $CGI::Carp::WARN = 1;
 
-my $save_expect_l = $expect_l = __LINE__ + 1;
+$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");
@@ -171,7 +171,7 @@ 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 $save_expect_l. -->\n",
+is( $fake_out, "<!-- warning: There is a problem at $fname line 100. -->\n",
                         'warningsToBrowser() on' );
 
 is($CGI::Carp::EMIT_WARNINGS, 1, "Warnings turned off");
diff --git a/lib/CGI/t/cookie.t b/lib/CGI/t/cookie.t
index a2012e5..f02d113 100644 (file)
--- a/lib/CGI/t/cookie.t
+++ b/lib/CGI/t/cookie.t
@@ -1,11 +1,12 @@
 #!/usr/local/bin/perl -w
 
-BEGIN {
-    chdir 't' if -d 't';
-    @INC = '../lib';
-}
-
+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 => 86;
 use CGI::Util qw(escape unescape);
 use POSIX qw(strftime);
diff --git a/lib/CGI/t/fast.t b/lib/CGI/t/fast.t
index 2374d9f..45f8e12 100644 (file)
--- a/lib/CGI/t/fast.t
+++ b/lib/CGI/t/fast.t
@@ -1,15 +1,13 @@
 #!./perl -w
 
-use vars qw( $CGI::Q $CGI::Fast::Ext_Request );
+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 {
-       chdir 't' if -d 't';
-
-       # unshift, don't assign, so FCGI can be found if it's installed
-       # unlikely, but possible
-       unshift @INC, '../lib';
-
        local $@;
        eval { require FCGI };
        $fcgi = $@ ? 0 : 1;
@@ -17,6 +15,10 @@ BEGIN {
 
 use Test::More tests => 7;
 
+# Shut up "used only once" warnings.
+() = $CGI::Q;
+() = $CGI::Fast::Ext_Request;
+
 SKIP: {
        skip( 'FCGI not installed, cannot continue', 7 ) unless $fcgi;
 
diff --git a/lib/CGI/t/form.t b/lib/CGI/t/form.t
index 3b09198..344e7f0 100755 (executable)
--- a/lib/CGI/t/form.t
+++ b/lib/CGI/t/form.t
@@ -1,5 +1,11 @@
 #!/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 Test::More tests => 17;
 
 BEGIN { use_ok('CGI'); };
@@ -73,30 +79,30 @@ is(checkbox(-name     => 'weather',
            -label    => 'forecast',
            -checked  => 1,
            -override => 1),
-   qq(<input type="checkbox" name="weather" value="nice" checked />forecast),
+   qq(<input type="checkbox" name="weather" value="nice" checked="1" />forecast),
    "checkbox()");
 
 is(checkbox(-name  => 'weather',
            -value => 'dull',
            -label => 'forecast'),
-   qq(<input type="checkbox" name="weather" value="dull" checked />forecast),
+   qq(<input type="checkbox" name="weather" value="dull" checked="1" />forecast),
    "checkbox()");
 
 is(radio_group(-name => 'game'),
-   qq(<input type="radio" name="game" value="chess" checked />chess ).
+   qq(<input type="radio" name="game" value="chess" checked="1" />chess ).
    qq(<input type="radio" name="game" value="checkers" />checkers),
    'radio_group()');
 
 is(radio_group(-name   => 'game',
               -labels => {'chess' => 'ping pong'}),
-   qq(<input type="radio" name="game" value="chess" checked />ping pong ).
+   qq(<input type="radio" name="game" value="chess" checked="1" />ping pong ).
    qq(<input type="radio" name="game" value="checkers" />checkers),
    'radio_group()');
 
 is(checkbox_group(-name   => 'game',
                  -Values => [qw/checkers chess cribbage/]),
-   qq(<input type="checkbox" name="game" value="checkers" checked />checkers ).
-   qq(<input type="checkbox" name="game" value="chess" checked />chess ).
+   qq(<input type="checkbox" name="game" value="checkers" checked="1" />checkers ).
+   qq(<input type="checkbox" name="game" value="chess" checked="1" />chess ).
    qq(<input type="checkbox" name="game" value="cribbage" />cribbage),
    'checkbox_group()');
 
@@ -105,7 +111,7 @@ is(checkbox_group(-name       => 'game',
                  '-defaults' => ['cribbage'],-override=>1),
    qq(<input type="checkbox" name="game" value="checkers" />checkers ).
    qq(<input type="checkbox" name="game" value="chess" />chess ).
-   qq(<input type="checkbox" name="game" value="cribbage" checked />cribbage),
+   qq(<input type="checkbox" name="game" value="cribbage" checked="1" />cribbage),
    'checkbox_group()');
 
 is(popup_menu(-name     => 'game',
@@ -116,7 +122,7 @@ is(popup_menu(-name     => 'game',
 <select name="game">
 <option  value="checkers">checkers</option>
 <option  value="chess">chess</option>
-<option selected value="cribbage">cribbage</option>
+<option selected="1" value="cribbage">cribbage</option>
 </select>
 END
 
diff --git a/lib/CGI/t/function.t b/lib/CGI/t/function.t
index 9f5deb8..d72382c 100755 (executable)
--- a/lib/CGI/t/function.t
+++ b/lib/CGI/t/function.t
@@ -1,15 +1,12 @@
 #!/usr/local/bin/perl -w
 
-BEGIN {
-    chdir('t') if -d 't';
-    @INC = '../lib';
-}
+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..27\n"; }
+BEGIN {$| = 1; print "1..28\n"; }
 END {print "not ok 1\n" unless $loaded;}
 use Config;
 use CGI (':standard','keywords');
@@ -109,3 +106,5 @@ test(25,redirect('http://somewhere.else') eq "Status: 302 Moved${CRLF}Location:
 my $h = redirect(-Location=>'http://somewhere.else',-Type=>'text/html');
 test(26,$h eq "Status: 302 Moved${CRLF}Location: http://somewhere.else${CRLF}Content-Type: text/html; charset=ISO-8859-1${CRLF}${CRLF}","CGI::redirect() 2");
 test(27,redirect(-Location=>'http://somewhere.else/bin/foo&bar',-Type=>'text/html') eq "Status: 302 Moved${CRLF}Location: http://somewhere.else/bin/foo&bar${CRLF}Content-Type: text/html; charset=ISO-8859-1${CRLF}${CRLF}","CGI::redirect() 2");
+
+test(28,escapeHTML('CGI') eq 'CGI','escapeHTML(CGI) failing again');
diff --git a/lib/CGI/t/html.t b/lib/CGI/t/html.t
index 643bbde..91523fe 100755 (executable)
--- a/lib/CGI/t/html.t
+++ b/lib/CGI/t/html.t
@@ -1,10 +1,5 @@
 #!/usr/local/bin/perl -w
 
-BEGIN {
-    chdir('t') if -d 't';
-    @INC = '../lib';
-}
-
 # Test ability to retrieve HTTP request info
 ######################### We start with some black magic to print on failure.
 use lib '../blib/lib','../blib/arch';
@@ -15,7 +10,11 @@ use CGI (':standard','-no_debug','*h3','start_table');
 $loaded = 1;
 print "ok 1\n";
 
-no utf8; # we contain Latin-1
+if( $] > 5.006 ) {
+    # no utf8
+    require utf8; # we contain Latin-1
+    utf8->unimport;
+}
 
 ######################### End of black magic.
 
diff --git a/lib/CGI/t/pretty.t b/lib/CGI/t/pretty.t
index 14f6447..9a311fb 100755 (executable)
--- a/lib/CGI/t/pretty.t
+++ b/lib/CGI/t/pretty.t
@@ -1,41 +1,40 @@
 #!/usr/local/bin/perl -w
 
-BEGIN {
-    chdir('t') if -d 't';
-    @INC = '../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..5\n"; }
-END {print "not ok 1\n" unless $loaded;}
-use CGI::Pretty (':standard','-no_debug','*h3','start_table');
-$loaded = 1;
-print "ok 1\n";
-
-######################### End of black magic.
-
-# util
-sub test {
-    local($^W) = 0;
-    my($num, $true,$msg) = @_;
-    print($true ? "ok $num\n" : "not ok $num $msg\n");
-}
-
-# all the automatic tags
-test(2,h1() eq '<h1>',"single tag");
-test(3,ol(li('fred'),li('ethel')) eq "<ol>\n\t<li>\n\t\tfred\n\t</li>\n\t <li>\n\t\tethel\n\t</li>\n</ol>\n","basic indentation");
-test(4,p('hi',pre('there'),'frog') eq 
-'<p>
+use strict;
+use lib 't/lib','../blib/lib','./blib/lib';
+use Test::More tests => 5;
+
+BEGIN { use_ok('CGI::Pretty') };
+
+# This is silly use_ok should take arguments
+use CGI::Pretty (':all');
+
+is(h1(), '<h1>',"single tag");
+
+is(ol(li('fred'),li('ethel')), <<HTML,   "basic indentation");
+<ol>
+       <li>
+               fred
+       </li>
+       <li>
+               ethel
+       </li>
+</ol>
+HTML
+
+
+is(p('hi',pre('there'),'frog'), <<HTML, "<pre> tags");
+<p>
        hi <pre>there</pre>
-        frog
+       frog
 </p>
-',"<pre> tags");
-test(5,p('hi',a({-href=>'frog'},'there'),'frog') eq 
-'<p>
+HTML
+
+
+is(p('hi',a({-href=>'frog'},'there'),'frog'), <<HTML,   "as-is");
+<p>
        hi <a href="frog">there</a>
-        frog
+       frog
 </p>
-',"as-is");
+HTML
+
diff --git a/lib/CGI/t/push.t b/lib/CGI/t/push.t
index 2459c1f..2c48d60 100644 (file)
--- a/lib/CGI/t/push.t
+++ b/lib/CGI/t/push.t
@@ -1,9 +1,10 @@
 #!./perl -wT
 
-BEGIN {
-       chdir 't' if -d 't';
-       @INC = '../lib';
-}
+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; 
 
@@ -12,7 +13,7 @@ use_ok( 'CGI::Push' );
 ok( my $q = CGI::Push->new(), 'create a new CGI::Push object' );
 
 # test the simple_counter() method
-like( join('', $q->simple_counter(10)) , qr/updated.+?10.+?times./, 'counter' );
+like( join('', $q->simple_counter(10)) , '/updated.+?10.+?times./', 'counter' );
 
 # test do_sleep, except we don't want to bog down the tests
 # there's also a potential timing-related failure lurking here
@@ -43,7 +44,7 @@ my %vars = (
 $q->do_push(%vars);
 
 # this seems to appear on every page
-like( $$out, qr/WARNING: YOUR BROWSER/, 'unsupported browser warning' );
+like( $$out, '/WARNING: YOUR BROWSER/', 'unsupported browser warning' );
 
 # these should appear correctly
 is( ($$out =~ s/next page//g), 2, 'next_page callback called appropriately' );
@@ -52,7 +53,7 @@ is( ($$out =~ s/last page//g), 1, 'last_page callback called appropriately' );
 # send a fake content type (header capitalization varies in CGI, CGI::Push)
 $$out = '';
 $q->do_push(%vars, -type => 'fake' );
-like( $$out, qr/Content-[Tt]ype: fake/, 'set custom Content-type' );
+like( $$out, '/Content-[Tt]ype: fake/', 'set custom Content-type' );
 
 # use our own counter, as $COUNTER in CGI::Push is now off
 my $i;
@@ -69,7 +70,7 @@ $q->do_push(
 );
 
 # header capitalization again, our word should appear only once
-like( $$out, qr!ype: text/plain!, 'set custom Content-type in next_page()' );
+like( $$out, '/ype: text\/plain/', 'set custom Content-type in next_page()' );
 is( $$out =~ s/arduk//g, 1, 'found text from next_page()' );
        
 package TieOut;
diff --git a/lib/CGI/t/request.t b/lib/CGI/t/request.t
index fde3fd0..96775a9 100755 (executable)
--- a/lib/CGI/t/request.t
+++ b/lib/CGI/t/request.t
@@ -1,10 +1,5 @@
 #!/usr/local/bin/perl -w
 
-BEGIN {
-    chdir('t') if -d 't';
-    @INC = '../lib';
-}
-
 # Test ability to retrieve HTTP request info
 ######################### We start with some black magic to print on failure.
 use lib '../blib/lib','../blib/arch';
diff --git a/lib/CGI/t/switch.t b/lib/CGI/t/switch.t
index 25a3325..ac58618 100644 (file)
--- a/lib/CGI/t/switch.t
+++ b/lib/CGI/t/switch.t
@@ -1,5 +1,11 @@
 #!/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/lib/CGI/t/util.t b/lib/CGI/t/util.t
index f0471cf..8f9da3b 100644 (file)
--- a/lib/CGI/t/util.t
+++ b/lib/CGI/t/util.t
@@ -1,10 +1,5 @@
 #!/usr/local/bin/perl -w
 
-BEGIN {
-    chdir('t') if -d 't';
-    @INC = '../lib';
-}
-
 # Test ability to escape() and unescape() punctuation characters
 # except for qw(- . _).
 ######################### We start with some black magic to print on failure.
Unnamed repository; edit this file to name it for gitweb.