1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
|
use strict;
use warnings;
use Test::More;
use File::LibMagic;
my %standard = (
'foo.foo' => [ 'ASCII text', 'text/plain; charset=us-ascii' ],
'foo.c' => [ 'C source, ASCII text', 'text/x-c; charset=us-ascii' ],
);
my %custom = (
'foo.foo' => [ 'A foo file', 'text/plain; charset=us-ascii' ],
'foo.c' => [ 'ASCII text', 'text/plain; charset=us-ascii' ],
);
plan tests => 4 + 4*(keys %standard) + 4*(keys %custom);
# try using a the standard magic database
my $flm = File::LibMagic->new();
isa_ok($flm, 'File::LibMagic');
while ( my ($file, $expect) = each %standard ) {
my ($descr, $mime) = @$expect;
$file = "t/samples/$file";
# the original file utility uses text/plain;... so does gentoo, debian,
# etc ..., but OpenSUSE returns text/plain... (no semicolon)
$mime=~s/;/;?/g;
like( $flm->checktype_filename($file), qr#$mime#, "MIME $file" );
is ( $flm->describe_filename($file), $descr, "Describe $file" );
my $data = do {
local $/;
open my $fh, '<', $file or die $!;
<$fh>;
};
like( $flm->checktype_contents($data), qr#$mime#, "MIME data $file" );
is ( $flm->describe_contents($data), $descr, "Describe data $file" );
}
# try using a custom magic database
$flm = File::LibMagic->new('t/samples/magic');
isa_ok($flm, 'File::LibMagic');
while ( my ($file, $expect) = each %custom ) {
my ($descr, $mime) = @$expect;
$file = "t/samples/$file";
# OpenSUSE fix
$mime=~s/;/;?/g;
# text/x-foo to keep netbsd and older solaris installations happy
like( $flm->checktype_filename($file), qr#(?:$mime|text/x-foo)#, "MIME $file" );
is( $flm->describe_filename($file), $descr, "Describe $file" );
my $data = do {
local $/;
open my $fh, '<', $file or die $!;
<$fh>;
};
# text/x-foo to keep netbsd and older solaris installations happy
like( $flm->checktype_contents($data), qr#(?:$mime|text/x-foo)#, "MIME data $file" );
is( $flm->describe_contents($data), $descr, "Describe data $file" );
}
my $subclass = My::Magic::Subclass->new();
isa_ok( $subclass, 'My::Magic::Subclass', 'subclass' );
is( $subclass->checktype_filename('t/samples/missing'), 'text/x-test-passes' );
# define a subclass of File::LibMagic to test subclassing
package My::Magic::Subclass;
use base qw( File::LibMagic );
sub checktype_filename { 'text/x-test-passes' }
|
