From: Peter Prymmer Date: Mon, 5 Feb 2001 16:26:36 +0000 (-0800) Subject: provide EBCDIC CGI::Util::escape() and test X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=92dffb52e8549d6a194db47a2e5b989b8338a19a;p=p5sagit%2Fp5-mst-13.2.git provide EBCDIC CGI::Util::escape() and test Message-ID: p4raw-id: //depot/perl@8726 --- diff --git a/MANIFEST b/MANIFEST index 72b1edd..ecb3e51 100644 --- a/MANIFEST +++ b/MANIFEST @@ -1383,6 +1383,7 @@ t/lib/bigfloat.t See if bigfloat.pl works t/lib/bigfltpm.t See if BigFloat.pm works t/lib/bigint.t See if bigint.pl works t/lib/bigintpm.t See if BigInt.pm works +t/lib/cgi-esc.t See if CGI.pm works t/lib/cgi-form.t See if CGI.pm works t/lib/cgi-function.t See if CGI.pm works t/lib/cgi-html.t See if CGI.pm works diff --git a/lib/CGI/Util.pm b/lib/CGI/Util.pm index ac7376d..0049667 100644 --- a/lib/CGI/Util.pm +++ b/lib/CGI/Util.pm @@ -1,7 +1,7 @@ package CGI::Util; use strict; -use vars '$VERSION','@EXPORT_OK','@ISA','$EBCDIC','@A2E'; +use vars '$VERSION','@EXPORT_OK','@ISA','$EBCDIC','@A2E','@E2A'; require Exporter; @ISA = qw(Exporter); @EXPORT_OK = qw(rearrange make_attributes unescape escape expires); @@ -10,6 +10,7 @@ $VERSION = '1.1'; $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, @@ -28,6 +29,44 @@ if ($EBCDIC) { 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 @@ -114,7 +153,11 @@ sub escape { shift() if ref($_[0]) || (defined $_[1] && $_[0] eq $CGI::DefaultClass); my $toencode = shift; return undef unless defined($toencode); - $toencode=~s/([^a-zA-Z0-9_.-])/uc sprintf("%%%02x",ord($1))/eg; + if ($EBCDIC) { + $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; + } return $toencode; } diff --git a/t/lib/cgi-esc.t b/t/lib/cgi-esc.t new file mode 100644 index 0000000..f0471cf --- /dev/null +++ b/t/lib/cgi-esc.t @@ -0,0 +1,56 @@ +#!/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. +use lib '../blib/lib','../blib/arch'; + +BEGIN {$| = 1; print "1..59\n"; } +END {print "not ok 1\n" unless $loaded;} +use Config; +use CGI::Util qw(escape unescape); +$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"); +} + +# ASCII order, ASCII codepoints, ASCII repertoire + +my %punct = ( + ' ' => '20', '!' => '21', '"' => '22', '#' => '23', + '$' => '24', '%' => '25', '&' => '26', '\'' => '27', + '(' => '28', ')' => '29', '*' => '2A', '+' => '2B', + ',' => '2C', '/' => '2F', # '-' => '2D', '.' => '2E' + ':' => '3A', ';' => '3B', '<' => '3C', '=' => '3D', + '>' => '3E', '?' => '3F', '[' => '5B', '\\' => '5C', + ']' => '5D', '^' => '5E', '`' => '60', # '_' => '5F', + '{' => '7B', '|' => '7C', '}' => '7D', '~' => '7E', + ); + +# The sort order may not be ASCII on EBCDIC machines: + +my $i = 1; + +foreach(sort(keys(%punct))) { + $i++; + my $escape = "AbC\%$punct{$_}dEF"; + my $cgi_escape = escape("AbC$_" . "dEF"); + test($i, $escape eq $cgi_escape , "# $escape ne $cgi_escape"); + $i++; + my $unescape = "AbC$_" . "dEF"; + my $cgi_unescape = unescape("AbC\%$punct{$_}dEF"); + test($i, $unescape eq $cgi_unescape , "# $unescape ne $cgi_unescape"); +} +