#!/usr/bin/perl -w
#
# image_info
#
# AUTHOR:
#   Dan Harkless                                                    <opensource@
#   http://harkless.org/dan/software/                              harkless.org>
# 
# COPYRIGHT:
#   This file is Copyright (C) 2010 by Dan Harkless, and is released under the
#   GNU General Public License <http://www.gnu.org/copyleft/gpl.html>.
#
# USAGE:
#   % image_info <image_file_1> [<image_file_2>...]
#
# DESCRIPTION:
#   Uses the Image::ExifTool module (available on CPAN) to get info on the image
#   filenames specified on the commandline, then prints this info out.  So that
#   you can easily grep for particular values of particular attributes in a 
#   range of files, each file attribute is printed on its own line (in
#   case-sensitive alphabetical order), with each line prefixed by 
#   "<filename>: " if you've specified more than one file on the commandline.
#
#   Previously this script used the Image::Info module, and with it, sometimes
#   files would contain more than one image (e.g. the main image plus an
#   embedded thumbnail), causing us to further prefix each line we output with
#   "Image <n>: ".  However, it appears this code no longer gets triggered now
#   that we're using Image::ExifTool, and instead the module appears to print
#   pieces of data that appear more than once in the file with " (1)" before the
#   colon on the second instance.
#
#   If a value looks like binary data (it contains a character that isn't
#   printable in ISO Latin 1), we just print the string "(binary data)".  If
#   values contain embedded NULs (like the EXIF UserComment field), these are
#   changed to spaces.  Trailing NULs are ignored.  Other than this binary data
#   and NUL handling, we do no interpretation of the data passed back by
#   Image::ExifTool, printing it as-is.
#
# DATE        MODIFICATION
# ==========  ==================================================================
# 2010-08-13  Came across a photo that was causing "error: Can't bless non-
#             reference value at <path_omitted>/Image/TIFF.pm line 935.".  Tried
#             upgrading to the latest version of Image::Info (which was 
#             deprecated last time I looked at it in 2008 but now has a new
#             maintainer), but that didn't help.  Upgrading Image::TIFF might
#             help, but instead rewrote image_info to use Image::ExifTool.  I'll
#             archive the old Image::Info version as 
#             <http://harkless.org/dan/software/old/image_info.Image::Info>.
# 2008-09-02  "use English qw(-no_match_vars)": avoid regex performance penalty.
# 2002-03-09  Original.


## Modules used ################################################################
use English qw(-no_match_vars);  # allow use of names like @ARG rather than @_
use File::Basename;              # for basename()
use Image::ExifTool qw(:Public);


## Subroutines #################################################################
sub recursively_print_ref {
    my $arg = shift;
    my $arg_type = ref($arg);
    my $val;

    if ($arg_type eq "ARRAY") {
	my $first_one = 1;

	print "(";
	foreach $val (@$arg) {
	    if (not $first_one) {
		print ", ";
	    }
	    else {
		$first_one = 0;
	    }
	    recursively_print_ref($val);
	}
	print ")";
    }
    elsif ($arg_type eq "HASH") {
	my $first_one = 1;
	my $key;

	print "(";
	foreach $key (sort keys %$arg) {
	    if (not $first_one) {
		print ", ";
	    }
	    else {
		$first_one = 0;
	    }
	    print "$key = ";
	    recursively_print_ref($$arg{$key});
	}
	print ")";
    }
    else {
	if ($arg =~ /^([\x00\t\n\r\x20-\x7E\xA0-\xFF]*?)\x00*$/) {
	    # Characters are all ISO Latin 1 (or NUL, which we convert) -- 
	    # hopefully this means this value is human-readable (and not just a
	    # selection of binary data that happens to only use Latin 1 values).
	    $arg_without_trailing_NULs = $1;
	    $arg_without_trailing_NULs =~ s/\x00/ /g;  # embedded NULs -> spaces
	    print $arg_without_trailing_NULs;
	}
	else {
	    # Binary data -- we're hands-off.  (Which unfortunately means that
	    # right now we refuse to print non-Western-language comments.  To
	    # fix this, we could do special processing on comment fields (like
	    # the EXIF UserComment) that are defined to allow, for instance,
	    # Japanese comments.)
	    print "(binary data)";
	}
    }
}


## Main ########################################################################
$number_of_files = scalar @ARGV;

if ($number_of_files < 1) {
    $progname = basename($PROGRAM_NAME);  # strip off the path
    print STDERR "Usage: $progname <image_file_1> [<image_file_2>...]\n";
    exit 1;
}

foreach $file (@ARGV) {
    if ($number_of_files > 1) {
	$file_prefix_string = "$file: ";
    }
    else {
	$file_prefix_string = "";
    }
    $prefix_string = $file_prefix_string;

    # TBD: The below is probably no longer necessary now that we're using
    #      Image::ExifTool, but leaving it this way is fine too.
    #
    # Image::Info (up to 1.09, at least) doesn't do proper error handling --
    # errors are not catchable by an eval and are printed (in a goofy format) on
    # STDOUT rather than STDERR.  Therefore, we need to try to open the file
    # ourself, then do proper error reporting or pass the filehandle to
    # ImageInfo(), as appropriate.
    if (not open(FILE, $file)) {
	print STDERR "$file: $OS_ERROR.\n";
    }
    else {
	@hash_refs = ImageInfo(\*FILE);
	$number_of_images_in_file = scalar @hash_refs;
	
	foreach $i (1 .. $number_of_images_in_file) {
	    if ($number_of_images_in_file > 1) {
		$prefix_string = $file_prefix_string . "Image $i: ";
	    }
	    
	    $hash_ref = $hash_refs[$i - 1];
	    
	    foreach $key (sort keys %$hash_ref) {
		print "$prefix_string$key: ";
		recursively_print_ref($$hash_ref{$key});
		print "\n";
	    }
	}

	close FILE;
    }
}