mediatypes.t   [plain text]

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);
}