Update to CGI.pm 2.78.

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.
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