10 print "ok " . $no++ . "\n";
20 # ID QS Content-Type Encoding Char-Set Lang Size
23 ['var1', 0.950, 'text/plain', ['uuencode',
24 'compress'], 'iso-8859-2', 'se', 400],
25 ['var2', 1.000, 'text/html;version=2.0', 'gzip', 'iso-8859-1', 'en', 3000],
26 ['var3', 0.333, 'image/gif', undef, undef, undef, 43555],
30 # First we try a request with not accept headers
31 $request = new HTTP::Request 'GET', 'http://localhost/';
32 @a = choose($variants, $request);
34 expect(\@a, [['var2' => 1],
41 $a = choose($variants, $request);
42 print "The chosen one is '$a'\n";
52 $request = new HTTP::Request 'GET', 'http://localhost/';
53 $request->header('Accept', 'text/plain; q=0.55, image/gif; mbx=10000');
54 $request->push_header('Accept', 'text/*; q=0.25');
55 $request->header('Accept-Language', 'no, en');
56 $request->header('Accept-Charset', 'iso-8859-1');
57 $request->header('Accept-Encoding', 'gzip');
59 @a = choose($variants, $request);
61 expect(\@a, [['var2' => 0.25],
68 ['var-en', undef, 'text/html', undef, undef, 'en', undef],
69 ['var-de', undef, 'text/html', undef, undef, 'de', undef],
70 ['var-ES', undef, 'text/html', undef, undef, 'ES', undef],
71 ['provoke-warning', undef, undef, undef, undef, 'x-no-content-type', undef],
74 $HTTP::Negotiate::DEBUG=1;
75 $ENV{HTTP_ACCEPT_LANGUAGE}='DE,en,fr;Q=0.5,es;q=0.1';
77 $a = choose($variants);
88 [ 'Canadian English' => 1.0, 'text/html', undef, undef, 'en-CA', undef ],
89 [ 'Generic English' => 1.0, 'text/html', undef, undef, 'en', undef ],
90 [ 'Non-Specific' => 1.0, 'text/html', undef, undef, undef, undef ],
93 $ENV{HTTP_ACCEPT_LANGUAGE}='en-US';
94 $a = choose($variants);
95 if ($a eq 'Generic English') {
110 last if defined($a) ne defined($b);
115 print "$va == $vb ?\n";
119 if (abs($qa - $qb) > 0.002) {
120 print "$qa ~= $qb ?\n";
126 } until (!defined($a) || !defined($b));
127 return not_ok if defined($a) ne defined($b);
133 print "-------------\n";
135 printf "%-6s %.3f\n", @$_;
137 print "-------------\n";