This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Integrate:
[perl5.git] / lib / CGI / Util.pm
index aba0ba5..6c5d543 100644 (file)
@@ -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.31';
 
 $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
@@ -115,7 +115,12 @@ sub make_attributes {
     foreach (keys %{$attr}) {
        my($key) = $_;
        $key=~s/^\-//;     # get rid of initial - if present
-       $key=~tr/A-Z_/a-z-/; # parameters are lower case, use dashes
+
+       # old way: breaks EBCDIC!
+       # $key=~tr/A-Z_/a-z-/; # parameters are lower case, use dashes
+
+       ($key="\L$key") =~ tr/_/-/; # parameters are lower case, use dashes
+
        my $value = $escape ? simple_escape($attr->{$_}) : $attr->{$_};
        push(@att,defined($attr->{$_}) ? qq/$key="$value"/ : qq/$key/);
     }
@@ -134,9 +139,48 @@ sub simple_escape {
   $toencode;
 }
 
+sub utf8_chr ($) {
+        my $c = shift(@_);
+
+        if ($c < 0x80) {
+                return sprintf("%c", $c);
+        } elsif ($c < 0x800) {
+                return sprintf("%c%c", 0xc0 | ($c >> 6), 0x80 | ($c & 0x3f));
+        } elsif ($c < 0x10000) {
+                return sprintf("%c%c%c",
+                                           0xe0 |  ($c >> 12),
+                                           0x80 | (($c >>  6) & 0x3f),
+                                           0x80 | ( $c          & 0x3f));
+        } elsif ($c < 0x200000) {
+                return sprintf("%c%c%c%c",
+                                           0xf0 |  ($c >> 18),
+                                           0x80 | (($c >> 12) & 0x3f),
+                                           0x80 | (($c >>  6) & 0x3f),
+                                           0x80 | ( $c          & 0x3f));
+        } elsif ($c < 0x4000000) {
+                return sprintf("%c%c%c%c%c",
+                                           0xf8 |  ($c >> 24),
+                                           0x80 | (($c >> 18) & 0x3f),
+                                           0x80 | (($c >> 12) & 0x3f),
+                                           0x80 | (($c >>  6) & 0x3f),
+                                           0x80 | ( $c          & 0x3f));
+
+        } elsif ($c < 0x80000000) {
+                return sprintf("%c%c%c%c%c%c",
+                                           0xfe |  ($c >> 30),
+                                           0x80 | (($c >> 24) & 0x3f),
+                                           0x80 | (($c >> 18) & 0x3f),
+                                           0x80 | (($c >> 12) & 0x3f),
+                                           0x80 | (($c >> 6)  & 0x3f),
+                                           0x80 | ( $c          & 0x3f));
+        } else {
+                return utf8(0xfffd);
+        }
+}
+
 # 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
@@ -144,16 +188,19 @@ sub unescape {
     if ($EBCDIC) {
       $todecode =~ s/%([0-9a-fA-F]{2})/chr $A2E[hex($1)]/ge;
     } else {
-      $todecode =~ s/%([0-9a-fA-F]{2})/chr hex($1)/ge;
+      $todecode =~ s/%(?:([0-9a-fA-F]{2})|u([0-9a-fA-F]{4}))/
+       defined($1)? chr hex($1) : utf8_chr(hex($2))/ge;
     }
   return $todecode;
 }
 
 # 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);
+  # 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;
     } else {