/usr/share/perl5/File/Type/WebImages.pm is in libfile-type-webimages-perl 1.01-1.
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 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 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 | package File::Type::WebImages;
use strict;
use warnings;
use base 'Exporter';
use vars '@EXPORT_OK';
@EXPORT_OK = 'mime_type';
use IO::File;
our $VERSION = "1.01";
sub mime_type {
# magically route argument
my $argument = shift;
return undef unless defined $argument;
if (length $argument > 1024 || $argument =~ m/\n/) {
# assume it's data. Saves a stat call if the data's long
# also avoids stat warning if there's a newline
return checktype_contents($argument);
}
if (-e $argument) {
if (!-d $argument) {
return checktype_filename($argument);
} else {
return undef; # directories don't have mime types
}
}
# otherwise, fall back to checking the string as if it's data again
return checktype_contents($argument);
}
# reads in 16k of selected file, or returns undef if can't open,
# then checks contents
sub checktype_filename {
my $filename = shift;
my $fh = IO::File->new($filename) || return undef;
my $data;
$fh->read($data, 16*1024);
$fh->close;
return checktype_contents($data);
}
# Matches $data against the magic database criteria and returns the MIME
# type of the file.
sub checktype_contents {
my $data = shift;
my $substr;
return undef unless defined $data;
if ($data =~ m[^\x89PNG]) {
return q{image/png};
}
elsif ($data =~ m[^GIF8]) {
return q{image/gif};
}
elsif ($data =~ m[^BM]) {
return q{image/bmp};
}
if (length $data > 1) {
$substr = substr($data, 1, 1024);
if (defined $substr && $substr =~ m[^PNG]) {
return q{image/png};
}
}
if (length $data > 0) {
$substr = substr($data, 0, 2);
if (pack('H*', 'ffd8') eq $substr ) {
return q{image/jpeg};
}
}
return undef;
}
1;
__END__
=head1 NAME
File::Type::WebImages - determine web image file types using magic
=head1 SYNOPSIS
use File::Type::WebImages 'mime_type';
my $type_1 = mime_type($file);
my $type_2 = mime_type($data);
=head1 DESCRIPTION
C<mime_type()> can use either a filename, or file contents, to determine the
type of a file. The process involves looking the data at the beginning of the file,
sometimes called "magic numbers".
=head1 THE BIG TRADE OFF
For minimum memory consumption, only the following common web image file types are supported:
BMP, GIF, JPEG and PNG.
( image/bmp, image/gif, image/jpeg and image/png ).
Unlike with L<File::Type> and L<File::MMagic>, 'undef', not
"application/octet-stream" will be returned for unknown formats.
Unlike L<File::Type>, we return "image/png" for PNGs, I<not> "image/x-png";
If you want more mime types detected use L<File::Type> or some other module.
=head1 TODO
It would be even better to have a pluggable system that would allow you
to plug-in different sets of MIME-types you care about.
=head1 SEE ALSO
L<File::Type>. Similar, but supports over 100 file types.
=head1 ACKNOWLEDGMENTS
File::Type::WebImages is built from a mime-magic file from cleancode.org. The original
can be found at L<http://cleancode.org/cgi-bin/viewcvs.cgi/email/mime-magic.mime?rev=1.1.1.1>.
=head1 AUTHORS
Paul Mison <pmison@fotango.com> - wrote original File::Type
Mark Stosberg <mark@summersault.com> - hacked up this.
=head1 COPYRIGHT
Copyright 2003-2004 Fotango Ltd.
=head1 LICENSE
Licensed under the same terms as Perl itself.
=cut
|