Commit | Line | Data |
---|---|---|
92dffb52 PP |
1 | #!/usr/local/bin/perl -w |
2 | ||
92dffb52 PP |
3 | # Test ability to escape() and unescape() punctuation characters |
4 | # except for qw(- . _). | |
5 | ######################### We start with some black magic to print on failure. | |
8f3ccfa2 JH |
6 | use lib '../blib/lib','../blib/arch'; |
7 | ||
8869a4b7 | 8 | BEGIN {$| = 1; print "1..57\n"; } |
92dffb52 PP |
9 | END {print "not ok 1\n" unless $loaded;} |
10 | use Config; | |
11 | use CGI::Util qw(escape unescape); | |
12 | $loaded = 1; | |
13 | print "ok 1\n"; | |
14 | ||
15 | ######################### End of black magic. | |
16 | ||
17 | # util | |
18 | sub 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 | ||
26 | my %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', | |
8869a4b7 | 34 | '{' => '7B', '|' => '7C', '}' => '7D', # '~' => '7E', |
92dffb52 PP |
35 | ); |
36 | ||
37 | # The sort order may not be ASCII on EBCDIC machines: | |
38 | ||
39 | my $i = 1; | |
40 | ||
41 | foreach(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 |