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
|
print "1..3\n";
use HTTP::Request;
use HTTP::Negotiate;
$no = 1;
sub ok
{
print "ok " . $no++ . "\n";
}
sub not_ok
{
print "not ";
ok;
}
# ID QS Content-Type Encoding Char-Set Lang Size
$variants =
[
['var1', 0.950, 'text/plain', ['uuencode',
'compress'], 'iso-8859-2', 'se', 400],
['var2', 1.000, 'text/html;version=2.0', 'gzip', 'iso-8859-1', 'en', 3000],
['var3', 0.333, 'image/gif', undef, undef, undef, 43555],
];
# First we try a request with not accept headers
$request = new HTTP::Request 'GET', 'http://localhost/';
@a = choose($variants, $request);
show_res(@a);
expect(\@a, [['var2' => 1],
['var1' => 0.95],
['var3' => 0.333]
]
);
$a = choose($variants, $request);
print "The chosen one is '$a'\n";
if ($a eq 'var2') {
ok;
} else {
not_ok;
}
#------------------
$request = new HTTP::Request 'GET', 'http://localhost/';
$request->header('Accept', 'text/plain; q=0.55, image/gif; mbx=10000');
$request->push_header('Accept', 'text/*; q=0.25');
$request->header('Accept-Language', 'no, en');
$request->header('Accept-Charset', 'iso-8859-1');
$request->header('Accept-Encoding', 'gzip');
@a = choose($variants, $request);
show_res(@a);
expect(\@a, [['var2' => 0.25],
['var1' => 0],
['var3' => 0]
]
);
#------------------
sub expect
{
my($res, $exp) = @_;
do {
$a = shift @$res;
$b = shift @$exp;
last if defined($a) ne defined($b);
if (defined($a)) {
($va, $qa) = @$a;
($vb, $qb) = @$b;
if ($va ne $vb) {
print "$va == $vb ?\n";
not_ok;
return;
}
if (abs($qa - $qb) > 0.002) {
print "$qa ~= $qb ?\n";
not_ok;
return;
}
}
} until (!defined($a) || !defined($b));
return not_ok if defined($a) ne defined($b);
ok;
}
sub show_res
{
print "-------------\n";
for (@_) {
printf "%-6s %.3f\n", @$_;
}
print "-------------\n";
}
|
