/usr/share/defoma/libperl-file.pl is in defoma 0.11.12ubuntu1.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
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 | sub get_file_category {
my $file = shift;
my $ret = `/usr/bin/file $file`;
chomp($ret);
$ret = substr($ret, length($file) + 2);
if ($ret eq 'ASCII text') {
if ($file =~ /\.hints$/) {
return 'hintfile';
}
} elsif ($ret =~ /PostScript/) {
if ($ret =~ /PostScript Type 1 font/) {
return 'type1';
} else {
if (open(F, $file)) {
my $l = scalar(<F>);
close F;
chomp($l);
if ($l =~ /Resource-CMap/) {
return 'cmap';
} elsif ($l =~ /Resource-Font/) {
return 'psfont';
} elsif ($l =~ /Resource-CIDFont/) {
return 'cid';
}
}
return 'unknown';
}
} elsif ($ret eq 'MS Windows TrueType font') {
return 'truetype';
} elsif ($ret eq 'data' && $file =~ /\.ttc/i) {
if (open(F, $file)) {
my $l = substr(scalar(<F>), 0, 4);
close F;
if ($l eq 'ttcf') {
return 'truetype';
}
}
return 'unknown';
}
return 'unknown';
}
1;
|