| Subject: | [PATCH] Adds direct access to the determine_file_format logic |
Image::Info (the base module) has the ability to detect the image type without loading a driver and using only the first 32 bytes of a file, yet this ability is not available to the user.
While the determine_file_format function does exist, it is not important, and doesn't enjoy the same input flexibility as image_info does.
This dramatically slows down processes that _only_ want to know the type of a file, without needing to know all the extra stuff.
This patch adds the 'image_type' function, which works in the same way as image_info, but returns a hash with only a single key 'file_type' which is the value returned by determine_file_format.
I also abstracted a few bits and pieces out into separate functions to avoid excessive code duplication.
Because I've edited directly inside the .tmpl file, I haven't had the chance to test that it works, but it's a fairly simple change so I don't see why it should pass all tests.
You may want to add one more additional quickie test to load each of the test files and make sure it detects properly, but that is more of a formality than anything, since it uses the same code.
--- Info.pm.tmpl.old 2004-10-31 21:28:30.000000000 +1100
+++ Info.pm.tmpl 2004-10-31 21:30:17.000000000 +1100
@@ -10,7 +10,7 @@
use vars qw($VERSION @EXPORT_OK);
-$VERSION = '1.16';
+$VERSION = '1.17';
require Exporter;
*import = \&Exporter::import;
@@ -21,8 +21,56 @@
sub image_info
{
- my($source, %cnf) = @_;
+ my $source = _source(shift);
+ return $source if ref $source eq 'HASH'; # Pass on errors
+ # What sort of file is it?
+ my $head = _head($source)
+ or return _os_err("Can't read head");
+ my $format = determine_file_format($head)
+ or return { error => 'Unrecognized file format' };
+
+ no strict 'refs';
+ my $mod = "Image::Info::$format";
+ my $sub = "$mod\::process_file";
+ my $info = bless [], "Image::Info::Result";
+ eval {
+ unless (defined &$sub) {
+ if (my $fail = $mod_failure{$mod}) {
+ die $fail;
+ }
+ eval "require $mod";
+ if ($@) {
+ $mod_failure{$mod} = $@;
+ die $@;
+ }
+ die "$mod did not define &$sub" unless defined &$sub;
+ }
+
+ my %cnf = @_;
+ &$sub($info, $source, \%cnf);
+ $info->clean_up;
+ };
+ return { error => $@ } if $@;
+ return wantarray ? @$info : $info->[0];
+}
+
+sub image_type
+{
+ my $source = _source(shift);
+ return $source if ref $source eq 'HASH'; # Pass on errors
+
+ # What sort of file is it?
+ my $head = _head($source) or return _os_err("Can't read head");
+ my $format = determine_file_format($head)
+ or return { error => "Unrecognized file format" };
+
+ return { file_type => $format };
+}
+
+sub _source
+{
+ my $source = shift;
if (!ref $source) {
require Symbol;
my $fh = Symbol::gensym();
@@ -45,8 +93,14 @@
seek($source, 0, 0) or return _os_err("Can't rewind");
}
- my $head;
- read($source, $head, 32) or return _os_err("Can't read head");
+ return $source;
+}
+
+sub _head
+{
+ my $source = shift;
+ my $head = read($source, $head, 32);
+
if (ref($source) eq "IO::String") {
# XXX workaround until we can trap seek() with a tied file handle
$source->setpos(0);
@@ -55,31 +109,7 @@
seek($source, 0, 0) or _os_err("Can't rewind");
}
- if (my $format = determine_file_format($head)) {
- no strict 'refs';
- my $mod = "Image::Info::$format";
- my $sub = "$mod\::process_file";
- my $info = bless [], "Image::Info::Result";
- eval {
- unless (defined &$sub) {
- if (my $fail = $mod_failure{$mod}) {
- die $fail;
- }
- eval "require $mod";
- if ($@) {
- $mod_failure{$mod} = $@;
- die $@;
- }
- die "$mod did not define &$sub" unless defined &$sub;
- }
-
- &$sub($info, $source, \%cnf);
- $info->clean_up;
- };
- return { error => $@ } if $@;
- return wantarray ? @$info : $info->[0];
- }
- return { error => "Unrecognized file format" };
+ return $head;
}
sub _os_err
@@ -149,7 +179,13 @@
die "Can't parse image info: $error\n";
}
my $color = $info->{color_type};
-
+
+ my $type = image_type("image.jpg");
+ if (my $error = $type->{error}) {
+ die "Can't determine file type: $error\n";
+ }
+ die "No gif files allowed!" if $type->{file_type} eq 'GIF';
+
my($w, $h) = dim($info);
=head1 DESCRIPTION
@@ -183,6 +219,35 @@
The image_info() function also take optional key/value style arguments
that can influence what information is returned.
+=item image_type( $file )
+
+=item image_info( \$imgdata )
+
+This function is a dramatically faster alternative to the image_info
+function for situations in which you B<only> need to find the image type.
+
+It uses only the internal file-type detection to do this, and thus does
+not need to load any of the image type-specific driver modules, and does
+not access to entire file. It also only needs access to the first 32
+bytes of the file.
+
+To maintain some level of compatibility with image_info, image_type
+returns in the same format, with the same error message style. That is,
+it returns a HASH reference, with the $type->{error} key set if there
+was an error.
+
+On success, the HASH reference will contain the single key 'file_type',
+which represents the type of the file, expressed as the type code used for
+the various drivers ('GIF', 'JPEG', 'TIFF' and so on).
+
+If there are multiple images within the file they will be ignored, as this
+function provides only the type of the overall file, not of the various
+images within it. This function will not return multiple hashes if the file
+contains multiple images.
+
+Of course, in all (or at least effectively all) cases the type of the images
+inside the file is going to be the same as that of the file itself.
+
=item dim( $info_hash )
Takes an hash as returned from image_info() and returns the dimensions
@@ -331,6 +396,8 @@
TIFF support by <clarsen@emf.net>.
+image_type by Adam Kennedy <cpan@ali.as>
+
This library is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.