X-Git-Url: http://git.maemo.org/git/?p=dh-make-perl;a=blobdiff_plain;f=dev%2Fi386%2Flibwww-perl%2Flibwww-perl-5.813%2Ft%2Fbase%2Fmediatypes.t;fp=dev%2Fi386%2Flibwww-perl%2Flibwww-perl-5.813%2Ft%2Fbase%2Fmediatypes.t;h=dc67197f24d5d2e6e779bcbcc898d83f3ff0ad7b;hp=0000000000000000000000000000000000000000;hb=8977e561d8a9eae6959218b0306c9df2056a38a9;hpb=df794b845212301ea0d267c919232538bfef356a

diff --git a/dev/i386/libwww-perl/libwww-perl-5.813/t/base/mediatypes.t b/dev/i386/libwww-perl/libwww-perl-5.813/t/base/mediatypes.t
new file mode 100644
index 0000000..dc67197
--- /dev/null
+++ b/dev/i386/libwww-perl/libwww-perl-5.813/t/base/mediatypes.t
@@ -0,0 +1,113 @@
+use LWP::MediaTypes;
+
+require URI::URL;
+
+$url1 = new URI::URL 'http://www/foo/test.gif?search+x#frag';
+$url2 = new URI::URL 'http:test';
+
+my $pwd if $^O eq "MacOS";
+
+unless ($^O eq "MacOS") {
+    $file = "/etc/passwd";
+    -r $file or $file = "./README";
+}
+else {
+    require Mac::Files;
+    $pwd = `pwd`;
+    chomp($pwd);
+    my $dir = Mac::Files::FindFolder(Mac::Files::kOnSystemDisk(),
+	                             Mac::Files::kDesktopFolderType());
+    chdir($dir);
+    $file = "README";
+    open(README,">$file") or die "Unable to open $file";
+    print README "This is a dummy file for LWP testing purposes\n";
+    close README;
+    open(README,">/dev/null") or die "Unable to open /dev/null";
+    print README "This is a dummy file for LWP testing purposes\n";
+    close README;
+}
+
+@tests =
+(
+ ["/this.dir/file.html" => "text/html",],
+ ["test.gif.htm"        => "text/html",],
+ ["test.txt.gz"         => "text/plain", "gzip"],
+ ["gif.foo"             => "application/octet-stream",],
+ ["lwp-0.03.tar.Z"      => "application/x-tar", "compress"],
+ [$file		        => "text/plain",],
+ ["/random/file"        => "application/octet-stream",],
+ [($^O eq 'VMS'? "nl:" : "/dev/null") => "text/plain",],
+ [$url1	        	=> "image/gif",],
+ [$url2	        	=> "application/octet-stream",],
+ ["x.ppm.Z.UU"		=> "image/x-portable-pixmap","compress","x-uuencode",],
+);
+
+$notests = @tests + 3;
+print "1..$notests\n";
+
+if ($ENV{HOME} and -f "$ENV{HOME}/.mime.types") {
+   warn "
+The MediaTypes test might fail because you have a private ~/.mime.types file
+If you get a failed test, try to move it away while testing.
+";
+}
+
+
+$testno = 1;
+for (@tests) {
+    ($file, $expectedtype, @expectedEnc) = @$_;
+    $type1 = guess_media_type($file);
+    ($type, @enc) = guess_media_type($file);
+    if ($type1 ne $type) {
+       print "guess_media_type does not return same content-type in scalar and array conext.\n";
+	next;
+    }
+    $type = "undef" unless defined $type;
+    if ($type eq $expectedtype and "@enc" eq "@expectedEnc") {
+	print "ok $testno\n";
+    }
+    else {
+	print "expected '$expectedtype' for '$file', got '$type'\n";
+	print "encoding: expected: '@expectedEnc', got '@enc'\n"
+	  if @expectedEnc || @enc;
+	print "nok ok $testno\n";
+    }
+    $testno++;
+}
+
+@imgSuffix = media_suffix('image/*');
+print "Image suffixes: @imgSuffix\n";
+
+print "\n";
+require HTTP::Response;
+$r = new HTTP::Response 200, "Document follows";
+$r->title("file.tar.gz.uu");
+guess_media_type($r->title, $r);
+print $r->as_string;
+
+print "not " unless $r->content_type eq "application/x-tar";
+print "ok $testno\n"; $testno++;
+
+@enc = $r->header("Content-Encoding");
+print "not " unless "@enc" eq "gzip x-uuencode";
+print "ok $testno\n"; $testno++;
+
+#
+use LWP::MediaTypes qw(add_type add_encoding);
+add_type("x-world/x-vrml", qw(wrl vrml));
+add_encoding("x-gzip" => "gz");
+add_encoding(rot13 => "r13");
+
+@x = guess_media_type("foo.vrml.r13.gz");
+#print "@x\n";
+print "not " unless "@x" eq "x-world/x-vrml rot13 x-gzip";
+print "ok $testno\n"; $testno++;
+
+#print LWP::MediaTypes::_dump();
+
+if($^O eq "MacOS") {
+    unlink "README";
+    unlink "/dev/null";
+    chdir($pwd);
+}
+