exiftool.pm

稀饭伊人相册系统继承了新天堂多用户相册系统的功能

#####################################################
#  LEO SuperCool BBS / LeoBBS X / 雷傲极酷超级论坛  #
#####################################################
# 基于山鹰(糊)、花无缺制作的 LB5000 XP 2.30 免费版  #
#   新版程序制作 & 版权所有: 雷傲科技 (C)(R)2004    #
#####################################################
#      主页地址： http://www.LeoBBS.com/            #
#      论坛地址： http://bbs.LeoBBS.com/            #
#####################################################

package ExifTool;

use strict;
require 5.002;
require Exporter;

use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
$VERSION = '2.3.6';
@ISA = qw(Exporter);
@EXPORT_OK = qw(ImageInfo LoadAllTables GetDescriptions GetShortcuts
                SetVerbose SetDateFormat EnablePrintConversion
                EnableCompositeTags WarnDuplicateTags
                SetByteOrder Get16u Get16s Get32u Get32s);

sub JpgInfo($);
sub TiffInfo($);
sub GifInfo($);
sub ProcessExif($$);
sub ProcessExifDir($$$$$$;$);
sub BuildCompositeTags();
sub FoundTag($$;$$);
sub GetTagInfo($$);
sub SaveDescriptions($);
sub GetTagTable($);
sub TagTableKeys($);
sub ExpandShortcuts($);
sub ExtractBinary($$;$);
sub AddCompositeTags($);
sub HexDump($;$%);
sub HexDumpTag($$;$%);

# extra tags that aren't truly EXIF tags, but are generated by the script
%ExifTool::extraTags = (
    'Comment'   => { 'Name'=>'Comment'  },
    'FileName'  => { 'Name'=>'FileName' },
    'FileSize'  => { 'Name'=>'FileSize',  'PrintConv'=>'sprintf("%.0fKB",$val/1024)' },
    'ExifData'  => { 'Name'=>'ExifData',  'PrintConv'=>'"(Exif data block)"' },
);

# public ExifTool variables
$ExifTool::verbose = 0;     # flag for verbose printing (1=verbose, 2=very verbose)

# byte sizes for the various EXIF format types
my @formatSize = (0,1,1,2,4,8,1,1,2,4,8,4,8);

# other variables
my %allTables;              # list of all tables loaded
my $swap_bytes;             # set if EXIF header is not native byte ordering
my $native_byte_order;      # native (CPU) byte ordering (0=big endian, 1=little)
my %tagValueConv;           # tag values saved after valueConv
my %tagPrintConv;           # tag values saved after printConv
my %compositeTags;          # composite tags
my %tagDescriptions;        # descriptions for all tags
my %fileOrder;              # order that tags were found in the file
my $numTagsFound;           # number of tags found
my $doPrintConversion = 1;  # flag to enable print conversion (PrintConv)
my $warnDuplicates;         # flag to warn about duplicate tag names
my $filename;               # image file name
my $exifData;               # EXIF data block
my $verbose = 0;            # flag for verbose printing (1=verbose, 2=very verbose)
my $doComposite = 1;        # flag to enable composite tags
my $file_size;              # size of file
my $file_pointer;           # pointer to file
my $requestedTags;          # reference to list of requested tag names (case insensitive)
my $date_format;            # format for printed dates (strftime format string)

# special tag names (not used for tag info)
my %specialTags = ( 'TableType'=>1, 'Format'=>1  ); 


#------------------------------------------------------------------------------
# ImageInfo - return specified information from image file
# Inputs: 0) filename
#         1-N) list of tag names to find (or tag list reference or options reference)
# Returns: reference to hash of tag/value pairs (with "Error" entry on error)
# Notes:
#   - if no tags names are specified, the values of all tags are returned
#   - can pass a reference to list of tags to find, in which case the list
#     will be updated with the tags found in the proper case and in the specified
#     order.
#   - case pass reference to hash specifying options
# Options:
#   SORT - sort order of returned tags: (INPUT [default], FILE or ALPHA)
# Examples:
#   my $tags = ExifTool::ImageInfo($file, 'DateTimeOriginal', 'ImageSize');
#   my $tags = ExifTool::ImageInfo($file, \@tag_list, { SORT=>'FILE'} );
sub ImageInfo($;)
{
    $filename = shift;
    my $sortOrder;

    # must load our main tag tables to get shortcuts, etc
    GetTagTable("TagTables::Exif::Main");

    # handle our input arguments
    my $arg;
    my @tag_args;
    while (defined ($arg = shift)) {
        if (ref $arg eq 'ARRAY') {
            $requestedTags = $arg;
        } elsif (ref $arg eq 'HASH') {
            $sortOrder = $$arg{'SORT'};
        } else {
            push @tag_args, $arg;
        }
    }
    if ($requestedTags) {
        push @$requestedTags, @tag_args;
    } else {
        $requestedTags = \@tag_args;
    }

    # initialize global variables
    undef %tagValueConv;
    undef %tagPrintConv;
    undef %fileOrder;
    $numTagsFound = 0;

    # expand shortcuts
    ExpandShortcuts($requestedTags);

    $file_size = -s $filename;
    unless (defined $file_size) {
        warn "Error opening file $filename\n";
        return { Error => 'Error opening file' };
    }
    my $name = $filename;
    $name =~ s/.*\///;  # remove path
    FoundTag('FileName', $name);
    FoundTag('FileSize', $file_size);

    undef $exifData;        # clear current EXIF data

    # read tags from the file
    if (open(EXIFTOOL_FILE,$filename)) {
        $file_pointer = \*EXIFTOOL_FILE;
        binmode(EXIFTOOL_FILE);
        if ($filename =~ /\.(jpg|jpeg|thm)$/i) {
            JpgInfo(\*EXIFTOOL_FILE);
        } elsif ($filename =~ /\.gif$/i) {
            GifInfo(\*EXIFTOOL_FILE);
        } elsif ($filename =~ /\.tiff{0,1}$/i) {
            TiffInfo(\*EXIFTOOL_FILE);
        } elsif ($filename =~ /\.crw$/i) {
            GetTagTable('TagTables::CanonRaw::Main'); # load the raw tables
            TagTables::CanonRaw::RawInfo(\*EXIFTOOL_FILE, $requestedTags);
        } else {
            warn "Unknown image file type $filename\n";
        }
    } else {
        warn "Error opening file $filename\n";
        return { Error => 'Error opening file' };
    }

    # return binary EXIF data block only if requested
    FoundTag('ExifData',$exifData) if grep /^ExifData$/i, @$requestedTags;

    # calculate composite tags
    BuildCompositeTags() if $doComposite;

    close(EXIFTOOL_FILE);   # close the file after building composite tags

    # generate the return list and assign values to the input hash
    my @tags;
    if (@$requestedTags) {
        # scan through the requested tags and generate list tags we found
        my $tag;
        foreach $tag (@$requestedTags) {
            unless (defined $fileOrder{$tag}) {
                # do case-insensitive check
                my @matches = (grep /^$tag$/i, keys %fileOrder);
                if (@matches) {
                    $tag = $matches[0]; # take first match
                } else {
                    # bogus file order entry to avoid warning if sorting in file order
                    $fileOrder{$tag} = 999; 
                }
            }
            push @tags, $tag;
        }
    } else {
        # return all tags since the input hash is empty
        @tags = keys %fileOrder;
        # use file order by default if no tags specified
        # (no such thing as 'INPUT' order in this case)
        $sortOrder = 'FILE' unless $sortOrder and $sortOrder eq 'ALPHA';
    }
    if ($sortOrder and $sortOrder ne 'INPUT') {
        my $order;
        if ($sortOrder eq 'ALPHA') {
            $order = sub { $a cmp $b };
        } else {
            $order = sub { $fileOrder{$a} <=> $fileOrder{$b} };
        }
        @$requestedTags = sort $order @tags;
    } else {
        @$requestedTags = @tags;
    }

    # build hash of return values
    my %returnedTagHash;
    foreach (@$requestedTags) {
        $returnedTagHash{$_} = $tagPrintConv{$_} if defined $tagPrintConv{$_};
    }

    return \%returnedTagHash;
}

#------------------------------------------------------------------------------
# load all TagTables
sub LoadAllTables()
{
    # load all of our non-referenced tables
    GetTagTable('TagTables::Exif::Main');
    GetTagTable('TagTables::CanonRaw::Main');
    GetTagTable('TagTables::XMP::Main');
    GetTagTable('TagTables::IPTC::Main');

    my @tableNames = keys %allTables;

    # recursively load all tables referenced by the current tables
    while (@tableNames) {
        my $tableName = pop @tableNames;
        my $table = GetTagTable($tableName);
        # look for any SubDirectory tables
        foreach (TagTableKeys($table)) {
            my @infoArray = GetTagInfoArray($table,$_);
            my $tagInfo;
            foreach $tagInfo (@infoArray) {
                my $subdir = $$tagInfo{'SubDirectory'} or next;
                my $tableName = $$subdir{'TagTable'} or next;
                next if $allTables{$tableName}; # next if table already loaded
                push @tableNames, $tableName;   # must scan this one too
            }
        }
    }
}

#------------------------------------------------------------------------------
# Expand shortcuts
# Inputs: 0) reference to list of tags
sub ExpandShortcuts($)
{
    my $tagList = shift || return;

    # expand shortcuts
    my @expandedTags;
    my $tag;
EXPAND_TAG:
    foreach $tag (@$tagList) {
        foreach (keys %TagTables::Exif::Shortcuts) {
            /^$tag$/i or next;
            push @expandedTags, @{$TagTables::Exif::Shortcuts{$_}};
            next EXPAND_TAG;
        }
        push @expandedTags, $tag;
    }
    @$tagList = @expandedTags;
}

#------------------------------------------------------------------------------
# Access functions

# Set verbose messages
sub SetVerbose { ++$verbose; ++$ExifTool::verbose; }

# Enable warnings about duplicate tags
sub WarnDuplicateTags() { $warnDuplicates = 1; }

# Get reference to hash of tag descriptions
sub GetDescriptions() { return \%tagDescriptions; }

# Get reference to shortcuts hash
sub GetShortcuts() { return \%TagTables::Exif::Shortcuts; }

# Set time format
sub SetDateFormat($) { $date_format = shift; }

#------------------------------------------------------------------------------
# Enable/Disable print conversion
# Inputs: 0) undefined or non-zero to enable print conversion, 0 to disable
# Returns: old value of print conversion flag
sub EnablePrintConversion
{
    my $oldVal = $doPrintConversion;
    $doPrintConversion = shift;
    $doPrintConversion = 1 unless defined $doPrintConversion;
    return $oldVal;
}

#------------------------------------------------------------------------------
# Enable/Disable calculation of composite tags
# Inputs: 0) undefined or non-zero to enable composite tags, 0 to disable
# Returns: old value of composite flag
sub EnableCompositeTags
{
    my $oldVal = $doComposite;
    $doComposite = shift;
    $doComposite = 1 unless defined $doComposite;
    return $oldVal;
}

#------------------------------------------------------------------------------
# Utility routines to for reading binary data values from file
# - uses value of $swap_bytes to determine byte ordering
#
sub Get16(@)
{
    my $template = shift;
    my $dataPt = shift;
    my $pos = shift || 0;
    my $val;
    if ($swap_bytes) {
        $val = substr($$dataPt,$pos+1,1) . substr($$dataPt,$pos,1);
    } else {
        $val = substr($$dataPt,$pos,2);
    }
    defined($val) or return undef;
    return unpack($template,$val);
}
sub Get32(@)
{
    my $template = shift;
    my $dataPt = shift;
    my $pos = shift || 0;
    my $val;
    if ($swap_bytes) {
        $val = substr($$dataPt,$pos+3,1) . substr($$dataPt,$pos+2,1) . 
               substr($$dataPt,$pos+1,1) . substr($$dataPt,$pos,1);
    } else {
        $val = substr($$dataPt,$pos,4);
    }
    defined($val) or return undef;
    return unpack($template,$val);
}
sub Get64(@)
{
    my $template = shift;
    my $dataPt = shift;
    my $pos = shift || 0;
    my $val;
    if ($swap_bytes) {
        $val = substr($$dataPt,$pos+7,1) . substr($$dataPt,$pos+6,1) .