1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
|
#!/usr/local/bin/perl -w
# Test ability to escape() and unescape() punctuation characters
# except for qw(- . _).
$| = 1;
use Test::More tests => 80;
use Config;
use_ok ( 'CGI::Util', qw(
escape
unescape
rearrange
ebcdic2ascii
ascii2ebcdic
) );
# 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");
is($escape, $cgi_escape , "# $escape ne $cgi_escape");
$i++;
my $unescape = "AbC$_" . "dEF";
my $cgi_unescape = unescape("AbC\%$punct{$_}dEF");
is($unescape, $cgi_unescape , "# $unescape ne $cgi_unescape");
}
# rearrange should return things in a consistent order, so when we pass through
# a hash reference it should sort the keys
for ( 1 .. 20 ) {
my %args = (
'-charset' => 'UTF-8',
'-type' => 'text/html',
'-content-type' => 'text/html; charset=iso-8859-1',
);
my @ordered = rearrange(
[
[ 'TYPE','CONTENT_TYPE','CONTENT-TYPE' ],
'STATUS',
[ 'COOKIE','COOKIES','SET-COOKIE' ],
'TARGET',
'EXPIRES',
'NPH',
'CHARSET',
'ATTACHMENT',
'P3P'
],
%args,
);
is_deeply(
[ @ordered ],
[
'text/html; charset=iso-8859-1',
undef,
undef,
undef,
undef,
undef,
'UTF-8',
undef,
undef
],
'rearrange not sensitive to hash key ordering'
);
}
ok( CGI::Util::utf8_chr( "1",1 ),'utf8_chr' );
ok( my $ebcdic = ascii2ebcdic( "A" ),'ascii2ebcdic' );
is( ebcdic2ascii( $ebcdic ),'A','ebcdic2ascii' );
|
