1#!/usr/local/bin/perl -w 2 3# Test ability to escape() and unescape() punctuation characters 4# except for qw(- . _). 5######################### We start with some black magic to print on failure. 6use lib '../blib/lib','../blib/arch'; 7 8BEGIN {$| = 1; print "1..57\n"; } 9END {print "not ok 1\n" unless $loaded;} 10use Config; 11use CGI::Util qw(escape unescape); 12$loaded = 1; 13print "ok 1\n"; 14 15######################### End of black magic. 16 17# util 18sub test { 19 local($^W) = 0; 20 my($num, $true,$msg) = @_; 21 print($true ? "ok $num\n" : "not ok $num $msg\n"); 22} 23 24# ASCII order, ASCII codepoints, ASCII repertoire 25 26my %punct = ( 27 ' ' => '20', '!' => '21', '"' => '22', '#' => '23', 28 '$' => '24', '%' => '25', '&' => '26', '\'' => '27', 29 '(' => '28', ')' => '29', '*' => '2A', '+' => '2B', 30 ',' => '2C', '/' => '2F', # '-' => '2D', '.' => '2E' 31 ':' => '3A', ';' => '3B', '<' => '3C', '=' => '3D', 32 '>' => '3E', '?' => '3F', '[' => '5B', '\\' => '5C', 33 ']' => '5D', '^' => '5E', '`' => '60', # '_' => '5F', 34 '{' => '7B', '|' => '7C', '}' => '7D', # '~' => '7E', 35 ); 36 37# The sort order may not be ASCII on EBCDIC machines: 38 39my $i = 1; 40 41foreach(sort(keys(%punct))) { 42 $i++; 43 my $escape = "AbC\%$punct{$_}dEF"; 44 my $cgi_escape = escape("AbC$_" . "dEF"); 45 test($i, $escape eq $cgi_escape , "# $escape ne $cgi_escape"); 46 $i++; 47 my $unescape = "AbC$_" . "dEF"; 48 my $cgi_unescape = unescape("AbC\%$punct{$_}dEF"); 49 test($i, $unescape eq $cgi_unescape , "# $unescape ne $cgi_unescape"); 50} 51 52