From ab7c5218426d7424b8f7b5c333870958ad6609da Mon Sep 17 00:00:00 2001
From: Lorry Tar Creator <lorry-tar-importer@lorry>
Date: Sat, 18 Feb 2012 12:31:54 +0000
Subject: HTTP-Negotiate-6.01

---
 t/negotiate.t | 112 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 112 insertions(+)
 create mode 100644 t/negotiate.t

(limited to 't')

diff --git a/t/negotiate.t b/t/negotiate.t
new file mode 100644
index 0000000..ef3f889
--- /dev/null
+++ b/t/negotiate.t
@@ -0,0 +1,112 @@
+#!perl -w
+
+use Test;
+plan tests => 5;
+
+use HTTP::Request;
+use HTTP::Negotiate;
+
+
+ #  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";
+ok($a, "var2");
+
+#------------------
+
+$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]
+	    ]
+);
+
+$variants = [
+  ['var-en', undef, 'text/html', undef, undef, 'en', undef],
+  ['var-de', undef, 'text/html', undef, undef, 'de', undef],
+  ['var-ES', undef, 'text/html', undef, undef, 'ES', undef],
+  ['provoke-warning',  undef, undef, undef, undef, 'x-no-content-type', undef],
+ ];
+
+$HTTP::Negotiate::DEBUG=1;
+$ENV{HTTP_ACCEPT_LANGUAGE}='DE,en,fr;Q=0.5,es;q=0.1';
+
+$a = choose($variants);
+
+ok($a, 'var-de');
+
+
+$variants = [
+  [ 'Canadian English' => 1.0, 'text/html', undef, undef, 'en-CA', undef ],
+  [ 'Generic English'  => 1.0, 'text/html', undef, undef, 'en',    undef ],
+  [ 'Non-Specific'     => 1.0, 'text/html', undef, undef, undef,   undef ],
+];
+
+$ENV{HTTP_ACCEPT_LANGUAGE}='en-US';
+$a = choose($variants);
+ok($a, 'Generic English');
+
+#------------------
+
+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";
+		ok(0);
+		return;
+	    }
+	    if (abs($qa - $qb) > 0.002) {
+		print "$qa ~= $qb ?\n";
+		ok(0);
+		return;
+	    }
+	}
+
+    } until (!defined($a) || !defined($b));
+    ok(defined($a), defined($b));
+}
+
+sub show_res
+{
+    print "-------------\n";
+    for (@_) {
+	printf "%-6s %.3f\n", @$_;
+    }
+    print "-------------\n";
+}
-- 
cgit v1.2.1