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
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
|
# please insert nothing before this line: -*- mode: cperl; cperl-indent-level: 4; cperl-continued-statement-offset: 4; indent-tabs-mode: nil -*-
package TestApache::util;
# Apache2::Util tests
use strict;
use warnings FATAL => 'all';
# to fully test this test the following locale settings need to be run:
#
# some /^en_/ locale, e.g. /^en_GB*
# LC_CTYPE=en_GB.UTF-8 LC_TIME=en_GB.UTF-8 t/TEST -verbose apache/util.t
# LC_CTYPE=en_GB LC_TIME=en_GB t/TEST -verbose apache/util.t
#
# some non-/^en_/ locale, e.g. ru_RU
# LC_CTYPE=ru_RU.UTF-8 LC_TIME=ru_RU.UTF-8 t/TEST -verbose apache/util.t
# LC_CTYPE=ru_RU LC_TIME=ru_RU t/TEST -verbose apache/util.t
# regex matching (LC_CTYPE) of strftime-like (LC_TIME) strings
use locale;
use Apache2::RequestRec ();
use Apache2::RequestIO ();
use Apache2::Util ();
use APR::Date ();
use Apache::TestUtil;
use Apache::Test;
use Apache2::Const -compile => 'OK';
# those are passed via PerlPassEnv
my $locale = $ENV{LC_TIME} || '';
my $parse_time_ok = $locale =~ /^en_/ ? 1 : 0;
my $locale_is_utf8 = $locale =~ /UTF-8$/ ? 1 : 0;
sub handler {
my $r = shift;
plan $r, tests => 8;
# ht_time
{
my $time = time;
my $fmt = "%a, %d %b %Y %H:%M:%S %Z";
my $fmtdate;
$fmtdate = Apache2::Util::ht_time($r->pool);
time_cmp($fmtdate, $time,
'Apache2::Util::ht_time($pool)', 0);
$fmtdate = Apache2::Util::ht_time($r->pool, $time);
time_cmp($fmtdate, $time,
'Apache2::Util::ht_time($pool, $time)', 1);
$fmtdate = Apache2::Util::ht_time($r->pool, $time, $fmt);
time_cmp($fmtdate, $time,
'Apache2::Util::ht_time($pool, $time, $fmt)', 1);
my $gmt = 0;
$fmtdate = Apache2::Util::ht_time($r->pool, $time, $fmt, $gmt);
time_cmp($fmtdate, $time,
'Apache2::Util::ht_time($pool, $time, $fmt, $gmt)', 0);
}
# escape_path
{
my ($uri, $received, $expected);
$uri = "a 'long' file?.html";
($expected = $uri) =~ s/([\s?;])/sprintf "%%%x", ord $1/ge;
$received = Apache2::Util::escape_path($uri, $r->pool);
ok t_cmp $received, $expected,
"Apache2::Util::escape_path / partial=1 / default";
$received = Apache2::Util::escape_path($uri, $r->pool, 1);
ok t_cmp $received, $expected,
"Apache2::Util::escape_path / partial=1 / explicit";
$received = Apache2::Util::escape_path($uri, $r->pool, 0);
ok t_cmp $received, $expected,
"Apache2::Util::escape_path / partial=0";
$uri = "a 'long' file?.html:";
($expected = $uri) =~ s/([\s?;])/sprintf "%%%x", ord $1/ge;
# XXX: why does it prepend ./ only if it sees : or :/?
$expected = "./$expected";
$received = Apache2::Util::escape_path($uri, $r->pool, 0);
ok t_cmp $received, $expected,
"Apache2::Util::escape_path / partial=0 / ./ prefix ";
}
Apache2::Const::OK;
}
my $fmtdate_re = qr/^\w+, \d\d \w+ \d\d\d\d \d\d:\d\d:\d\d/;
sub time_cmp {
my ($fmtdate, $time, $comment, $exact_match) = @_;
if ($parse_time_ok && $exact_match) {
my $ptime = APR::Date::parse_http($fmtdate);
t_debug "fmtdate: $fmtdate";
ok t_cmp $ptime, $time, $comment;
}
else {
if ($locale_is_utf8) {
if (have_min_perl_version(5.008)) {
require Encode;
# perl doesn't know yet that $fmtdate is a utf8 string
$fmtdate = Encode::decode_utf8($fmtdate);
}
else {
skip "Skip locale $locale needs perl 5.8.0+", 0;
return;
}
}
ok t_cmp $fmtdate, $fmtdate_re, $comment;
}
}
1;
__END__
|
