liblwp-mediatypes-perl/t/mediatypes.t

#!perl -w

use strict;
use Test::More;
use Test::Fatal;

use LWP::MediaTypes;

my $url1 = URI->new('http://www/foo/test.gif?search+x#frag');
my $url2 = URI->new('http:test');

my $file = "./README";

my $nocando = TestNoCanDo->new();
my $fh = TestFileTemp->new();

my @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",],
    [$fh          => "text/plain",],
    [$nocando     => "text/plain",],
);

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.
";
}


for (@tests) {
    my($file, $expectedtype, @expectedEnc) = @$_;
    my $type1 = guess_media_type($file);
    my($type, @enc) = guess_media_type($file);
    is($type1, $type);
    is($type, $expectedtype);
    is("@enc", "@expectedEnc");
}

like(
    exception {
        guess_media_type({});
    },
    qr/Unable to determine filetype on unblessed refs/,
    "Cannot pass unblessed refs"
);

my @imgSuffix = media_suffix('image/*');
note "Image suffixes: @imgSuffix";
ok(grep $_ eq "gif", @imgSuffix);

my @audioSuffix = media_suffix('AUDIO/*');
note "Audio suffixes: @audioSuffix";
ok(grep $_ eq 'oga', @audioSuffix);
is(media_suffix('audio/OGG'), 'oga');

my $r = Headers->new;
guess_media_type("file.tar.gz.uu", $r);
is($r->header("Content-Type"), "application/x-tar");

my @enc = $r->header("Content-Encoding");
is("@enc", "gzip x-uuencode");

#
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");

my @x = guess_media_type("foo.vrml.r13.gz");
#print "@x\n";
is("@x", "x-world/x-vrml rot13 x-gzip");

#print LWP::MediaTypes::_dump();

done_testing();

BEGIN {
    # mockups
    package URI;
    sub new {
	my($class, $str) = @_;
	bless \$str, $class;
    }

    sub path {
	my $self = shift;
	my $p = $$self;
	$p =~ s/[\?\#].*//;
	return $p;
    }

    package Headers;
    sub new {
	my $class = shift;
	return bless {}, $class;
    }

    sub header {
	my $self = shift;
	my $k = lc(shift);
	my $old = $self->{$k};
	if (@_) {
	    $self->{$k} = shift;
	}
	if (ref($old) eq "ARRAY") {
	    return @$old if wantarray;
	    return join(", ", @$old)
	}
	return $old;
    }

    package TestNoCanDo;

    sub new {
        my $class = shift;
        return bless {}, $class;
    }

    sub to_string {
        return "./README"
    }

    use overload '""' => 'to_string';

    package TestFileTemp;

    sub new {
        my $class = shift;
        return bless {}, $class;
    }

    sub filename {
        return "./README"
    }

}