git.maemo.org Git - pkg-perl/blob - deb-src/libwww-perl/libwww-perl-5.813/t/base/mediatypes.t

   1 use LWP::MediaTypes;
   2
   3 require URI::URL;
   4
   5 $url1 = new URI::URL 'http://www/foo/test.gif?search+x#frag';
   6 $url2 = new URI::URL 'http:test';
   7
   8 my $pwd if $^O eq "MacOS";
   9
  10 unless ($^O eq "MacOS") {
  11     $file = "/etc/passwd";
  12     -r $file or $file = "./README";
  13 }
  14 else {
  15     require Mac::Files;
  16     $pwd = `pwd`;
  17     chomp($pwd);
  18     my $dir = Mac::Files::FindFolder(Mac::Files::kOnSystemDisk(),
  19                                      Mac::Files::kDesktopFolderType());
  20     chdir($dir);
  21     $file = "README";
  22     open(README,">$file") or die "Unable to open $file";
  23     print README "This is a dummy file for LWP testing purposes\n";
  24     close README;
  25     open(README,">/dev/null") or die "Unable to open /dev/null";
  26     print README "This is a dummy file for LWP testing purposes\n";
  27     close README;
  28 }
  29
  30 @tests =
  31 (
  32  ["/this.dir/file.html" => "text/html",],
  33  ["test.gif.htm"        => "text/html",],
  34  ["test.txt.gz"         => "text/plain", "gzip"],
  35  ["gif.foo"             => "application/octet-stream",],
  36  ["lwp-0.03.tar.Z"      => "application/x-tar", "compress"],
  37  [$file                 => "text/plain",],
  38  ["/random/file"        => "application/octet-stream",],
  39  [($^O eq 'VMS'? "nl:" : "/dev/null") => "text/plain",],
  40  [$url1                 => "image/gif",],
  41  [$url2                 => "application/octet-stream",],
  42  ["x.ppm.Z.UU"          => "image/x-portable-pixmap","compress","x-uuencode",],
  43 );
  44
  45 $notests = @tests + 3;
  46 print "1..$notests\n";
  47
  48 if ($ENV{HOME} and -f "$ENV{HOME}/.mime.types") {
  49    warn "
  50 The MediaTypes test might fail because you have a private ~/.mime.types file
  51 If you get a failed test, try to move it away while testing.
  52 ";
  53 }
  54
  55
  56 $testno = 1;
  57 for (@tests) {
  58     ($file, $expectedtype, @expectedEnc) = @$_;
  59     $type1 = guess_media_type($file);
  60     ($type, @enc) = guess_media_type($file);
  61     if ($type1 ne $type) {
  62        print "guess_media_type does not return same content-type in scalar and array conext.\n";
  63         next;
  64     }
  65     $type = "undef" unless defined $type;
  66     if ($type eq $expectedtype and "@enc" eq "@expectedEnc") {
  67         print "ok $testno\n";
  68     }
  69     else {
  70         print "expected '$expectedtype' for '$file', got '$type'\n";
  71         print "encoding: expected: '@expectedEnc', got '@enc'\n"
  72           if @expectedEnc || @enc;
  73         print "nok ok $testno\n";
  74     }
  75     $testno++;
  76 }
  77
  78 @imgSuffix = media_suffix('image/*');
  79 print "Image suffixes: @imgSuffix\n";
  80
  81 print "\n";
  82 require HTTP::Response;
  83 $r = new HTTP::Response 200, "Document follows";
  84 $r->title("file.tar.gz.uu");
  85 guess_media_type($r->title, $r);
  86 print $r->as_string;
  87
  88 print "not " unless $r->content_type eq "application/x-tar";
  89 print "ok $testno\n"; $testno++;
  90
  91 @enc = $r->header("Content-Encoding");
  92 print "not " unless "@enc" eq "gzip x-uuencode";
  93 print "ok $testno\n"; $testno++;
  94
  95 #
  96 use LWP::MediaTypes qw(add_type add_encoding);
  97 add_type("x-world/x-vrml", qw(wrl vrml));
  98 add_encoding("x-gzip" => "gz");
  99 add_encoding(rot13 => "r13");
 100
 101 @x = guess_media_type("foo.vrml.r13.gz");
 102 #print "@x\n";
 103 print "not " unless "@x" eq "x-world/x-vrml rot13 x-gzip";
 104 print "ok $testno\n"; $testno++;
 105
 106 #print LWP::MediaTypes::_dump();
 107
 108 if($^O eq "MacOS") {
 109     unlink "README";
 110     unlink "/dev/null";
 111     chdir($pwd);
 112 }
 113