File::Type::WebImages - determine web image file types using magic

File-Type-WebImages documentation Contained in the File-Type-WebImages distribution.

Index

Code Index:

NAME

Top

File::Type::WebImages - determine web image file types using magic

SYNOPSIS

Top

    use File::Type::WebImages 'mime_type';

    my $type_1 = mime_type($file);
    my $type_2 = mime_type($data);

DESCRIPTION

Top

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

THE BIG TRADE OFF

Top

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 File::Type and File::MMagic, 'undef', not "application/octet-stream" will be returned for unknown formats.

Unlike File::Type, we return "image/png" for PNGs, not "image/x-png";

If you want more mime types detected use File::Type or some other module.

TODO

Top

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.

SEE ALSO

Top

File::Type. Similar, but supports over 100 file types.

ACKNOWLEDGMENTS

Top

File::Type::WebImages is built from a mime-magic file from cleancode.org. The original can be found at http://cleancode.org/cgi-bin/viewcvs.cgi/email/mime-magic.mime?rev=1.1.1.1.

AUTHORS

Top

Paul Mison <pmison@fotango.com> - wrote original File::Type Mark Stosberg <mark@summersault.com> - hacked up this.

COPYRIGHT

Top

Copyright 2003-2004 Fotango Ltd.

LICENSE

Top

Licensed under the same terms as Perl itself.

File-Type-WebImages documentation Contained in the File-Type-WebImages distribution. 
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__