#####################################################
#  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) . 
               substr($$dataPt,$pos+5,1) . substr($$dataPt,$pos+4,1) . 
               substr($$dataPt,$pos+3,1) . substr($$dataPt,$pos+2,1) . 
               substr($$dataPt,$pos+1,1) . substr($$dataPt,$pos,1);
    } else {
        $val = substr($$dataPt,$pos,8);
    }
    defined($val) or return undef;
    return unpack($template,$val);
}
# Inputs: 0) data reference, 1) offset into data (or zero)
sub Get32u($;$)    { return Get32('I', @_); }
sub Get32s($;$)    { return Get32('i', @_); }
sub Get16u($;$)    { return Get16('S', @_); }
sub Get16s($;$)    { return Get16('s', @_); }
sub GetFloat($;$)  { return Get32('f', @_); }
sub GetDouble($;$) { return Get64('d', @_); }

#------------------------------------------------------------------------------
# set byte ordering
# Inputs: 0) 'II'=intel, 'MM'=motorola
# Returns: 1 on success
sub SetByteOrder($)
{
    my $order = shift;
    my $exif_byte_order;

    if ($order eq 'MM') {
        $exif_byte_order = 0;   # big endian
    } elsif ($order eq 'II') {
        $exif_byte_order = 1;   # little endian
    } else {
        warn "Bad byte order tag\n";
        return 0;
    }
    my $val = unpack('S',"A ");
    if ($val == 0x4120) {
        $native_byte_order = 0;
    } elsif ($val == 0x2041) {
        $native_byte_order = 1;
    } else {
        warn sprintf("Internal byte order error - %x\n",$val);
        return 0;
    }
    # must swap bytes if our internal order is not the same as the EXIF
    $swap_bytes = ($exif_byte_order != $native_byte_order);

    return 1;
}

#------------------------------------------------------------------------------
# JpgInfo : return EXIF information from a jpg image
# Inputs: 0) file handle
sub JpgInfo($)
{
    my $JPEG = shift;
    my($ch,$s,$length,$buff) = (0,0,0,0);
    my($a,$b,$c,$d);

    if(defined($JPEG) && read($JPEG,$s,2)==2 && $s eq "\xff\xd8") {
        # read file until we reach an end of image (EOI) or start of scan (SOS)
        while (1){#ord($ch)!=0xda && ord($ch)!=0xd9) {
            # Find next marker (JPEG markers begin with 0xff)
            while (ord($ch) != 0xff) { read($JPEG, $ch, 1) or return; }
            # JPEG markers can be padded with unlimited 0xff's
            while (ord($ch) == 0xff) { read($JPEG, $ch, 1) or return; }
            if ((ord($ch) >= 0xc0) && (ord($ch) <= 0xc3)) {
                last unless read($JPEG, $buff, 3) == 3;
                last unless read($JPEG, $s, 4) == 4;
                ($a,$b,$c,$d) = unpack("C"x4,$s);
                # calculate the image size;
                my $w = ($c << 8) | $d;
                my $h = ($a << 8) | $b;
                FoundTag('ImageWidth', $w);
                FoundTag('ImageHeight', $h);
                # ignore stand-alone markers 0x01 and 0xd0-0xd7
            } elsif (ord($ch)!=0x01 and (ord($ch)<0xd0 or ord($ch)>0xd7)) {
                # We **MUST** skip variables, since FF's within variable names
                # are NOT valid JPEG markers
                last unless read($JPEG, $s, 2) == 2;
                ($a, $b) = unpack("C"x2,$s);
                $length = ($a << 8) | $b;   # get length
                last if (!defined($length) || $length < 2);
                last unless read($JPEG, $buff, $length-2) == $length-2;
                if (ord($ch) == 0xe1) {             # EXIF data
                    ProcessExif(\$buff, $length-2);
                } elsif (ord($ch) == 0xed) {        # IPTC data
                    my $tagTablePtr = GetTagTable('TagTables::IPTC::Main');
                    $verbose and print "-------- Start IPTC Data --------\n";
                    TagTables::IPTC::ProcessIPTC($tagTablePtr, \$buff, $length-2);
                    $verbose and print "-------- End IPTC Data --------\n";
                } elsif (ord($ch) == 0xfe) {        # JPG comment
                    FoundTag('Comment',$buff);
                }
            }  
        }
    }
}

#------------------------------------------------------------------------------
# TiffInfo : return EXIF information from a jpg image
# Inputs: 0) file handle
sub TiffInfo($)
{
    my $TIFF = shift;
    if (defined($TIFF) && read($TIFF,$exifData,8)==8) {
        # set our byte order from the 'II' or 'MM' at the file start
        SetByteOrder(substr($exifData,0,2)) or return;
        # verify the byte ordering
        Get16u(\$exifData,2) == 42 or return;
        my $offset = Get32u(\$exifData,4);  # offset to IFD
        $offset >= 8 or return;
        # read up to and including the IFD directory count
        my $buff;
        read($TIFF,$buff,$offset-6)==$offset-6 or return;
        $exifData .= $buff;
        my $length = 12 * Get16u(\$exifData,$offset);
        # read the directory
        read($TIFF,$buff,$length)==$length or return;
        $exifData .= $buff;
        # pass the file pointer to enable ProcessExifDir() to read
        # data directly from the file (the subdirectories and data in a
        # tiff file may be anywhere so it isn't feasible to load all of
        # the EXIF beforehand like with the JPG file)
        ProcessExifDir(GetTagTable('TagTables::Exif::Main'), \$exifData,
                       $offset, 0, $offset+$length+2, 0, $TIFF);
    } 
}

#------------------------------------------------------------------------------
# get GIF size and comments (no EXIF blocks in GIF files though)
# Inputs: 0) file handle
sub GifInfo($)
{
    my $GIF = shift;
    my($type,$a,$b,$c,$d,$s) = (0,0,0,0,0,0);
    my($ch, $length, $buff);

    unless(defined( $GIF )           &&
           read($GIF, $type, 6) == 6 &&
           $type =~ /GIF8[7,9]a/     &&
           read($GIF, $s, 4) == 4)
    {
        return;
    }
    ($a,$b,$c,$d) = unpack("C"x4, $s);
    my $w = ($b << 8) | $a;
    my $h = ($d << 8) | $c;
    FoundTag('ImageWidth', $w);
    FoundTag('ImageHeight', $h);
    if (read($GIF, $s, 3)==3) {
        if (ord($s) & 0x80) { # does this image contain a color table?
            # calculate color table size
            $length = 3 * (2 << (ord($s) & 0x07));
            read($GIF, $buff, $length);  # skip color table
            my $comment;
            for (;;) {
                last unless read($GIF, $ch, 1);
                if (ord($ch) == 0x2c) {
                    # image descriptor
                    last unless read($GIF, $buff, 8) == 8;
                    last unless read($GIF, $ch, 1);
                    if (ord($ch) & 0x80) { # does color table exist?
                        $length = 3 * (2 << (ord($ch) & 0x07));
                        # skip the color table
                        last unless read($GIF, $buff, $length) == $length;
                    }
                    # skip "LZW Minimum Code Size" byte
                    last unless read($GIF, $buff, 1);
                    # skip image blocks
                    for (;;) {
                        last unless read($GIF, $ch, 1);
                        last unless ord($ch);
                        last unless read($GIF, $buff, ord($ch));
                    }
                    next;  # continue with next field
                }
#               last if ord($ch) == 0x3b;  # normal end of GIF marker
                # check for a valid marker
                last unless ord($ch) == 0x21;
                last unless read($GIF, $s, 2) == 2;
                # get marker and block size
                ($a,$length) = unpack("C"x2, $s);
                if ($a == 0xfe) {  # is this a comment?
                    while ($length) {
                        last unless read($GIF, $buff, $length) == $length;
                        if (defined $comment) {
                            $comment .= $buff;  # add to comment string
                        } else {
                            $comment = $buff;
                        }
                        last unless read($GIF, $ch, 1);  # read next block header
                        $length = ord($ch);  # get next block size
                    }
                    last;  # all done once we have found the comment
                } else {
                    # skip the block
                    while ($length) {
                        last unless read($GIF, $buff, $length) == $length;
                        last unless read($GIF, $ch, 1);  # read next block header
                        $length = ord($ch);  # get next block size
                    }
                }
            }
            FoundTag('Comment', $comment) if $comment;
        }
    }
}

#------------------------------------------------------------------------------
# return printable value
# Inputs: 0) value to print
sub Printable($)
{
    my $outStr = shift;
    $outStr =~ tr/\x01-\x1f\x80-\xff/\./;
    $outStr =~ s/\x00//g;
    return $outStr;
}

#------------------------------------------------------------------------------
# get formatted value from binary data
# Inputs: 0) data reference, 1) offset to value, 2) format, 3) number of items
# Returns: Formatted value
sub FormattedValue($$$$)
{
    my $dataPt = shift;
    my $offset = shift;
    my $format = shift;
    my $count = shift;
    my $outVal;

    for (my $i=0; $i<$count; ++$i) {
        my $val;
        if ($format==1 or ($format==7 and $count==1)) { # unsigned byte or single unknown byte
            $val = unpack('C1',substr($$dataPt,$offset,1));
            ++$offset;
        } elsif ($format==3) {                  # unsigned short
            $val = Get16u($dataPt, $offset);
            $offset += 2;
        } elsif ($format==4) {                  # unsigned long
            $val = Get32u($dataPt, $offset);
            $offset += 4;
        } elsif ($format==5 or $format==10) {   # unsigned or signed rational
            my $denom = Get32s($dataPt,$offset+4);
            if ($denom) {
                $val = sprintf("%.4g",Get32s($dataPt,$offset)/$denom);
            } else {
                $val = 'inf';
            }
            $offset += 8;
        } elsif ($format==6) {                  # signed byte
            $val = unpack('c1',substr($$dataPt,$offset,1));
            ++$offset;
        } elsif ($format==8) {                  # signed short
            $val = Get16s($dataPt, $offset);
            $offset += 2;
        } elsif ($format==9) {                  # signed long
            $val = Get32s($dataPt, $offset);
            $offset += 4;
        } elsif ($format==11) {                 # float
            $val = GetFloat($dataPt, $offset);
            $offset += 4;
        } elsif ($format==12) {                 # double
            $val = GetDouble($dataPt, $offset);
            $offset += 8;
        } else {
            # handle everything else like a string (including ascii==2 and undefined==7)
            $outVal = substr($$dataPt, $offset, $count);
            last;   # already printed out the array
        }
        if (defined $outVal) {
            $outVal .= " $val";
        } else {
            $outVal = $val;
        }
    }
    return $outVal;
}

#------------------------------------------------------------------------------
# Dump data in hex and ASCII to console
# Inputs: 0) data reference, 1) length, 2-N) Options:
# Options: Start => offset to start of data (default=0)
#          Addr => address to print for data start (default=Start)
#          Width => width of printout (bytes, default=16)
#          Prefix => prefix to print at start of line (default='')
sub HexDump($;$%)
{
    my $dataPt = shift;
    my $len    = shift;
    my %opts   = @_;
    my $start  = $opts{'Start'}  || 0;
    my $addr   = $opts{'Addr'}   || $start;
    my $wid    = $opts{'Width'}  || 16;
    my $prefix = $opts{'Prefix'} || '';

    defined $len or $len = length($$dataPt) - $start;

    for (my $i=0; $i<$len; $i+=$wid) {
        $wid > $len-$i and $wid = $len-$i;
        printf "$prefix%8.4x: ", $addr+$i;
        my $dat = substr($$dataPt, $i+$start, $wid);
        printf "%-48s", join(' ',unpack("H*",$dat) =~ /../g);
        $dat =~ tr /\x00-\x1f\x7f-\xff/./;
        print "[$dat]\n";
    }
}

#------------------------------------------------------------------------------
# Dump tag data in hex and ASCII to console
# Inputs: 0) Tag number, 1) data reference, 2) length, 3-N) Options (See HexDump())
sub HexDumpTag($$;$%)
{
    my $tag    = shift;
    my $dataPt = shift;
    my $len    = shift;
    printf("  Tag 0x%.4x Hex Dump (%d bytes):\n",$tag, $len);
    HexDump($dataPt, $len, @_);
}

#------------------------------------------------------------------------------
# Convert time from Exif format
sub ConvertExifDate($)
{
    my $date = shift;
    # only convert date if a format was specified and the date is recognizable
    if ($date_format and $date =~ /^(\d+):(\d+):(\d+)\s+(\d+):(\d+):(\d+)/) {
        require POSIX;
        $date = POSIX::strftime($date_format, $6, $5, $4, $3, $2-1, $1-1900)
    }
    return $date;
}

#------------------------------------------------------------------------------
# add description to %tagDescriptions
# Inputs: 0) tag name, 1) description (optional)
sub AddDescription($;$)
{
    my $tag = shift;
    my $desc = shift;

    # just make the tag more readable if description doesn't exist
    # (put a space between lower-UPPER case combinations)
    $desc or ($desc = $tag) =~ s/([a-z])([A-Z])/$1 $2/g;
    $tagDescriptions{$tag} = $desc;
}

#------------------------------------------------------------------------------
# Get array of tag information
# Inputs: 0) Tag table reference, 1) tag value
# Returns: Array of tag information references
# Notes: Generates tagInfo hash if necessary
sub GetTagInfoArray($$)
{
    my $tagTablePtr = shift;
    my $tagVal = shift;
    my $tagInfo = $$tagTablePtr{$tagVal};

    my @infoArray;
    if (ref $tagInfo eq 'ARRAY') {
        @infoArray = @$tagInfo;
    } elsif ($tagInfo) {
        if (ref $tagInfo ne 'HASH') {
            # create hash with name
            $tagInfo = $$tagTablePtr{$tagVal} = { Name => $tagInfo };
        }
        push @infoArray, $tagInfo;
    }
    return @infoArray;
}

#------------------------------------------------------------------------------
# save descriptions of all tags in this hash
# Inputs: 0) Reference to tag table
# Notes: - checks for duplicate tags
#        - generates 'Name' field from key if it doesn't exist
sub SaveDescriptions($)
{
    my $tagTablePtr = shift;
    my $tagVal;
    foreach $tagVal (TagTableKeys($tagTablePtr)) {
        my @infoArray = GetTagInfoArray($tagTablePtr,$tagVal);
        my $tagInfo;
        # process conditional tagInfo arrays
        foreach $tagInfo (@infoArray) {
            my $tag = $$tagInfo{'Name'};
            unless (defined $tag) {
                $tag = $tagVal;     # generate name equal to tag value
                $$tagInfo{'Name'} = $tag;
            }
            if ($tagDescriptions{$tag}) {
                $warnDuplicates and warn "Warning: Duplicate tag name $tag\n";
                next;
            }
            AddDescription($tag, $$tagInfo{'Description'});
        }
    }
}

#------------------------------------------------------------------------------
# Return list of tag table keys (ignoring special keys)
# Inputs: 0) reference to tag table
# Returns: List of table keys
sub TagTableKeys($)
{
    my $tagTablePtr = shift;
    my @keyList;
    foreach (keys %$tagTablePtr) {
        push(@keyList, $_) unless $specialTags{$_};
    }
    return @keyList;
}

#------------------------------------------------------------------------------
# Add hash of composite tags to our composites
# Inputs: 0) reference to hash of composite tags
sub AddCompositeTags($)
{
    my  $add = shift;

    SaveDescriptions($add);

    foreach (keys %$add) {
        $compositeTags{$_} and warn "Duplicate composite tag $_\n";
        $compositeTags{$_} = $$add{$_};
    }
}

#------------------------------------------------------------------------------
# GetTagTable
# Inputs: 0) table name
# Returns: tag table reference, or undefined if not found
# Notes: will load table from a new file if required
sub GetTagTable($)
{
    my $tableName = shift or return undef;

    my $table = $allTables{$tableName};

    unless ($table) {
        unless (defined %$tableName) {
            # try to load module for this table
            if ($tableName =~ /(.*)::/) {
                my $module = $1;
                my $lib = "$module.pm";
                $lib =~ s/::/\//g;  # change '::' to '/'
                if (require $lib) {
                    # look for 'Composite' table and add it to our composites
                    if (defined %{"${module}::Composite"}) {
                        no strict 'refs';
                        AddCompositeTags(\%{"${module}::Composite"});
                    }
                } else {
                    warn "Error loading $lib\n";
                }
            }
            unless (defined %$tableName) {
                warn "Can't find table $tableName\n";
                return undef;
            }
        }
        no strict 'refs';
        $table = \%$tableName;
        # save all descriptions in the new table
        SaveDescriptions($table);
        # insert newly loaded table into list
        $allTables{$tableName} = $table;
    }
    return $table;
}

#------------------------------------------------------------------------------
# Find tag information, processing conditional tags
# Inputs: 0) tagTable pointer, 1) tag key
# Returns: pointer to tagInfo hash, or undefined if none found
sub GetTagInfo($$)
{
    my $tagTablePtr = shift;
    my $tag = shift;

    my $returnedInfo;
    my @infoArray = GetTagInfoArray($tagTablePtr, $tag);
    # evaluate condition
    my $tagInfo;
    foreach $tagInfo (@infoArray) {
        my $condition = $$tagInfo{'Condition'};
        if ($condition) {
            # set old value for use in condition if needed
            my $oldVal = $tagValueConv{$tagInfo->{'Name'}};
            next unless eval $condition;
        }
        $returnedInfo = $tagInfo;
        last;
    }
    return $returnedInfo;
}

#------------------------------------------------------------------------------
# found specified tag
# Inputs: 0) reference to tagInfo hash or tag string
#         1) data value (may be undefined if building composite tag)
#         2) optional reference to list of values used to build composite tags
#         3) optional reference to list of print values for composite tags
sub FoundTag($$;$$)
{
    my $tagInfo = shift;
    my $val = shift;
    my $valListPt = shift;
    my (@val, @valPrint);

    if ($valListPt) {
        my $valPrintPt = shift;
        @val = @$valListPt;
        @valPrint = @$valPrintPt;
    }
    if (ref($tagInfo) ne 'HASH') {
        my $table = GetTagTable('ExifTool::extraTags');
        # look for tag in extraTags
        if ($$table{$tagInfo}) {
            $tagInfo = $$table{$tagInfo};
        } else {
            # make temporary hash if using simple tag string
            # (not advised to do this since the tag won't show in list)
            $tagInfo = { 'Name' => $tagInfo };
        }
    }

    my $tag = $$tagInfo{'Name'};
    unless (defined $tag) {
        print "No tag name\n";
        return;
    }
    # convert the value into a usable form
    # (always do this conversion even if we don't want to return
    #  the value because the conversion may have side-effects)
    my $valueConversion = $$tagInfo{'ValueConv'};
    my $convertedVal;
    if ($valueConversion) {
        if (ref($valueConversion) eq 'HASH') {
            if (defined $$valueConversion{$val}) {
                $convertedVal = $$valueConversion{$val};
            } else {
                $convertedVal = "(ValueConv unknown value $val for $tag)";
            }
        } else {
            my $dataPt = \$exifData;   # set data ptr to be used in eval
            $convertedVal = eval $valueConversion;
            # allow eval to return undefined if it wants
            return unless defined $convertedVal;
        }
    } elsif (defined $val) {
        $convertedVal = $val;
    } else {
        # this is a composite tag that could not be calculated
        $verbose and warn "Can't get value for $tag\n";
        return;
    }
    $val = $convertedVal;
    $verbose and print "  $tag = ",Printable($val),"\n";

    # save the converted value
    $tagValueConv{$tag} = $val;

    # do the print conversion if required
    my $printConversion = $$tagInfo{'PrintConv'};
    if ($printConversion and $doPrintConversion) {
        if (ref($printConversion) eq 'HASH') {
            if (defined $$printConversion{$val}) {
                $convertedVal = $$printConversion{$val};
            } else {
                $convertedVal = "(PrintConv unknown value $val for $tag)";
            }
        } else {
            my $dataPt = \$exifData;   # set data ptr to be used in eval
            $convertedVal = eval $printConversion;
        }
    } else {
        $convertedVal = $val;
    }
    # truncate string at null terminator if doing print conversion
    # (necessary because some EXIF strings contain the NULL)
    $convertedVal =~ s/\0.*// if $doPrintConversion and defined $convertedVal;

    # save the print-converted value
    $tagPrintConv{$tag} = $convertedVal;

    # save the order of the tags we found
    $fileOrder{$tag} = $numTagsFound++;
}

#------------------------------------------------------------------------------
# Build composite tags from required tags
# Note: Tag values are calculated in alphabetical order unless a tag Require's
#       or Desire's another composite tag, in which case the calculation is
#       deferred until after the other tag is calculated.
sub BuildCompositeTags()
{
    my @tagList = sort keys %compositeTags;
    
    for (;;) {
        my %notBuilt;
        $notBuilt{$_} = 1 foreach @tagList;
        my @deferredTags;
        my $tag;
COMPOSITE_TAG:
        foreach $tag (@tagList) {
            my $tagInfo = GetTagInfo(\%compositeTags, $tag);
            next unless $tagInfo;
            # put required tags into array and make sure they all exist
            my @val;
            my @valPrint;
            my $index;
            my $type;
            foreach $type ('Require','Desire') {
                my $req = $$tagInfo{$type};
                $req or next;
                # save Require'd and Desire'd tag values in list
                foreach $index (keys %$req) {
                    my $req_tag = $$req{$index};
                    # calculate this tag later if it relies on another
                    # Composite tag which hasn't been calculated yet
                    if ($notBuilt{$req_tag}) {
                        push @deferredTags, $tag;
                        next COMPOSITE_TAG;
                    }
                    unless (defined $tagValueConv{$req_tag}) {
                        # don't continue if we require this tag
                        $type eq 'Require' and next COMPOSITE_TAG;
                    }
                    $val[$index] = $tagValueConv{$req_tag};
                    $valPrint[$index] = $tagPrintConv{$req_tag};
                }
            }
            delete $notBuilt{$tag}; # this tag is OK to build now
            unless ($$tagInfo{'ValueConv'}) {
                warn "Can't build composite tag $tag (no ValueConv)\n";
                next;
            }
            FoundTag($tagInfo, undef, \@val, \@valPrint);
        }
        last unless @deferredTags;
        if (@deferredTags == @tagList) {
            # everything was deferred in the last pass, 
            # must be a circular dependency
            warn "Circular dependency in Composite tags\n";
            last;
        }
        @tagList = @deferredTags; # calculate deferred tags now
    }
}

#------------------------------------------------------------------------------
# extract binary data from file
# 1) offset, 2) length, 3) tag name if conditional
# Returns: data or message if not requested, or undef on error
# Notes: Only extracts binary if specified tag is requested
sub ExtractBinary($$;$)
{
    my $offset = shift;
    my $length = shift;
    my $tag = shift;

    if ($tag and not grep /^$tag$/i, @$requestedTags) {
        return "(specify $tag explicitly to extract)";
    }
    if ($offset + $length > $file_size) {
        warn "Bad offset/length for $tag ($offset + $length > $file_size)\n";
        return undef;
    }
    my $buff;
    unless (seek($file_pointer,$offset,0) and read($file_pointer,$buff,$length)) {
        warn "Error reading $tag from file\n";
        return undef;
    }
    return $buff;
}

#------------------------------------------------------------------------------
# process binary data
# Inputs: 0) file pointer, 1) pointer to tag table, 2) data reference, 3) pointer offset
sub ProcessBinaryData($$$$)
{
    my $fp = shift;
    my $tagTablePtr = shift;
    my $dataPt = shift;
    my $offset = shift;
    my %format_size = ( 'short' => 2,
                        'ushort' => 2,
                        'long' => 4,
                        'ulong' => 4,
                        'string' => 1,
                        'char' => 1,
                        'uchar' => 1,
                        'shortrational' => 4,
                        'longrational' => 8,
                      );

    my $default_format = $$tagTablePtr{'Format'} || 'Short';   # short format by default
    my $increment = $format_size{lc($default_format)};
    unless ($increment) {
        warn "Unknown format $default_format\n";
        $default_format = 'Short';
        $increment = $format_size{lc($default_format)};
    }
    my $index;
    # extract information in the same order it appears in memory
    foreach $index (sort { $a <=> $b } TagTableKeys($tagTablePtr)) {
        my $tagInfo = GetTagInfo($tagTablePtr, $index);
        next unless $tagInfo;
        my $entry = $index * $increment;
        my $format = $$tagInfo{'Format'} || $default_format;
        my $val;
        if ($format =~ /^Short$/i) {
            $val = Get16s($dataPt, $entry + $offset);
        } elsif ($format =~ /^UShort$/i) {
            $val = Get16u($dataPt, $entry + $offset);
        } elsif ($format =~ /^Long$/i) {
            $val = Get32s($dataPt, $entry + $offset);
        } elsif ($format =~ /^ULong$/i) {
            $val = Get32u($dataPt, $entry + $offset);
        } elsif ($format =~ /^String\[(\d+)\]$/i) {
            $val = substr($$dataPt, $entry + $offset, $1);
        } elsif ($format =~ /^Char$/i) {
            $val = unpack('c', $val);
        } elsif ($format =~ /^UChar$/i) {
            $val = unpack('C', $val);
        } elsif ($format =~ /^ShortRational$/i) {
            my $denom = Get16s($dataPt, $entry + $offset + 2) || 1;
            $val = Get16s($dataPt, $entry + $offset) / $denom;
        } elsif ($format =~ /^LongRational$/i) {
            my $denom = Get32s($dataPt, $entry + $offset + 4) || 1;
            $val = Get32s($dataPt, $entry + $offset) / $denom;
        } else {
            warn "Unknown format $format\n";
        }
        FoundTag($tagInfo,$val);
    }
}

#------------------------------------------------------------------------------
# Process XMP directory
# Inputs: 0) Pointer to tag table, 1) XMP data reference
# Returns: 1 on success
sub ProcessXMPDir($$)
{
    my $tagTablePtr = shift;
    my $dataPt = shift;
    my @lines = split /(\n|\r)/,$$dataPt;

    $verbose and print "-------- Start XMP Data --------\n";
    foreach (@lines) {
        if (/<(.+?):(.+?)>(.+?)<\/\1:\2>/) {
            my $tag = $2;
            my $val = $3;
            if ($val =~ /^(-{0,1}\d+)\/(-{0,1}\d+)/) {
                $val = $1 / $2 if $2;       # calculate quotient
            } elsif ($val =~ /^(\d{4})-(\d{2})-(\d{2}).{1}(\d{2}:\d{2}:\d{2})/) {
                $val = "$1:$2:$3 $4";       # convert back to EXIF time format
            }
            # look up this tag in the XMP table
            if ($tagTablePtr and $$tagTablePtr{$tag}) {
                $tag = $$tagTablePtr{$tag};
            } elsif (not $tagDescriptions{$tag}) {
                # this tag wasn't in any table, so we need to add a description
                AddDescription($tag);
            }
            FoundTag($tag, $val);
        }
    }
    $verbose and print "-------- End XMP Data --------\n";
    return 1;
}

#------------------------------------------------------------------------------
# Process EXIF directory
# Inputs: 0) Pointer to tag table for this directory
#         1) Exif data reference
#         2) offset to directory start
#         3) offset base value
#         4) block size
#         5) nesting level
#         6) file pointer if allowed to seek outside current data
# Returns: 1 on success
sub ProcessExifDir($$$$$$;$)
{
    my $tagTablePtr = shift;
    my $dataPt = shift;
    my $dirStart = shift;
    my $offsetBase = shift;
    my $exifLength = shift;
    my $nesting = shift;
    my $fp = shift;
    my $success = 1;

    if ($nesting > 4) {
        warn "Nesting level too deep\n";
        return 0;
    }

    my $numEntries = Get16u($dataPt, $dirStart);

    $verbose and print "Directory with $numEntries entries\n";

    my $dirEnd = $dirStart + 2 + 12 * $numEntries;
    my $bytesFromEnd = $offsetBase + $exifLength - $dirEnd;
    if ($bytesFromEnd < 4) {
        unless ($bytesFromEnd==2 or $bytesFromEnd==0) {
            warn "Illegal directory size in $filename\n";
            return 0;
        }
    }

    # loop through all entries in EXIF directory
    for (my $index=0; $index<$numEntries; ++$index) {
        my $entry = $dirStart + 2 + 12 * $index;
        my $tag = Get16u($dataPt, $entry);
        my $format = Get16u($dataPt, $entry+2);
        my $numItems = Get32u($dataPt, $entry+4);
        if ($format >= 13) {
            warn "Bad EXIF directory entry format ($format)\n";
            next;
        }
        my $size = $numItems * $formatSize[$format];
        my $valuePtr = $entry + 8;
        my $valueData = $dataPt;
        if ($size > 4) {
            my $offsetVal = Get32u($dataPt, $valuePtr);
            if ($offsetVal+$size > $exifLength) {
                # get value by seeking in file if we are allowed
                if ($fp) {
                    my $curpos = tell($fp);
                    if (seek($fp,$offsetVal,0)) {
                        my $buff;
                        if (read($fp,$buff,$size) == $size) {
                            $valueData = \$buff;
                            $valuePtr = 0;
                        }
                    }
                    seek($fp,$curpos,0);  # restore position in file
                }
                if ($valuePtr) {
                    my $tagStr = sprintf("0x%x",$tag);
                    warn "Bad EXIF directory pointer value for tag $tagStr\n";
                    next;
                }
            } else {
                $valuePtr = $offsetBase + $offsetVal;
            }
        }
        my $value = FormattedValue($valueData,$valuePtr,$format,$numItems);
        my $tagInfo = GetTagInfo($tagTablePtr, $tag);
        unless ($tagInfo) {
            $verbose and printf("  Tag 0x%.4x, Format $format: %s\n", $tag, Printable($value));
            next;
        }
        $verbose>2 and HexDumpTag($tag, $valueData, $size, 'Start'=>$valuePtr);

#..............................................................................
# Handle SubDirectory tag types
#
        my $subdir = $$tagInfo{'SubDirectory'};
        if ($subdir) {

            my $tagStr = $$tagInfo{'Name'};
            defined $tagStr or $tagStr = sprintf("0x%x", $tag);
            
            # save the tag for debugging if verbose
            $verbose and FoundTag($tagInfo, $verbose>1 ? $value : '(SubDirectory)');
            
            my $dirData = $dataPt;
            my $dirBase = $offsetBase;
            my $dirLength = $exifLength;
            my $subdirStart;
            if (defined $$subdir{'Start'}) {
                $subdirStart = eval $$subdir{'Start'};
            } else {
                $subdirStart = 0;
            }
            # this is a pain, but some maker notes are always a specific
            # byte order, regardless of the byte order of the file
            my $newSwap = $swap_bytes;
            my $oldSwap = $swap_bytes;
            my $byteOrder = $$subdir{'ByteOrder'};
            if ($byteOrder) {
                my $dir_byte_order;
                if ($byteOrder =~ /^Little/i) {
                    $dir_byte_order = 1;
                } elsif ($byteOrder =~ /^Big/i) {
                    $dir_byte_order = 0;
                } else {
                    warn "Unknown byte order $byteOrder for $tagStr\n";
                    warn "(order must be either BigEndian or LittleEndian)\n";
                    next;
                }
                $newSwap = ($dir_byte_order != $native_byte_order);
            }
            # set base offset if necessary
            if ($$subdir{'Base'}) {
                my $start = $subdirStart;
                $dirBase = eval $$subdir{'Base'};
            }
            # add offset to the start of the directory if necessary
            if ($$subdir{'OffsetPt'}) {
                $swap_bytes = $newSwap;
                $subdirStart += Get32u($dataPt,eval $$subdir{'OffsetPt'});
                $swap_bytes = $oldSwap;
            }
            if ($subdirStart < $dirBase or $subdirStart > $dirBase + $dirLength) {
                my $dirOK;
                if ($fp) {
                    # read the directory from the file
                    my $curpos = tell($fp);
                    if (seek($fp,$subdirStart,0)) {
                        my $buff;
                        if (read($fp,$buff,2) == 2) {
                            # get no. dir entries
                            my $size = 12 * Get16u(\$buff, 0);
                            # read dir
                            my $buf2;
                            if (read($fp,$buf2,$size)) {
                                # set up variables to process new dir data
                                $buff .= $buf2;
                                $dirData = \$buff;
                                $subdirStart = 0;
                                $dirLength = $size + 2;
                                $dirBase = 0;
                                $dirOK = 1;
                            }
                        }
                    }
                    seek($fp,$curpos,0);  # restore position in file
                }
                unless ($dirOK) {
                    warn "Bad $tagStr SubDirectory start in $filename\n";
                    if ($verbose) {
                        if ($subdirStart < $dirBase) {
                            warn "(directory start $subdirStart is before EXIF base=$dirBase)\n";
                        } else {
                            my $end = $dirBase + $dirLength;
                            warn "(directory start $subdirStart is after EXIF end=$end)\n";
                        }
                    }
                    next;
                }
            }
            my $newTagTable;
            if ($$subdir{'TagTable'}) {
                $newTagTable = GetTagTable($$subdir{'TagTable'});
                unless ($newTagTable) {
                    warn "Unknown tag table $$subdir{TagTable}\n";
                    next;
                }
            } else {
                $newTagTable = $tagTablePtr;    # use existing table
            }
            my $subdirType = $$newTagTable{'TableType'};
            
            $swap_bytes = $newSwap;             # set byte order for this subdir
            # validate the subdirectory if necessary
            if (defined $$subdir{'Validate'} and not eval $$subdir{'Validate'}) {
                warn "Invalid $tagStr data\n";
            } elsif (not $subdirType) {
                # handle EXIF sub-directories
                $verbose and print "-------- $tagStr SubDirectory --------\n";
                ProcessExifDir($newTagTable, $dirData, $subdirStart,
                               $dirBase, $dirLength, $nesting+1,
                               $fp) or $success = 0;
                $verbose and print "-------- End $tagStr --------\n";
            } elsif ($subdirType eq 'BinaryData') {
                $verbose and print "........ Start $tagStr ........\n";
                ProcessBinaryData($fp, $newTagTable, $dirData, $subdirStart);
                $verbose and print "........ End $tagStr ........\n";
            } elsif ($subdirType eq 'CanonCustom') {
                # Must be unsigned or signed short
                if ($format==3 or $format==8) {
                    $verbose and print "........ Start $tagStr ........\n";
                    TagTables::CanonCustom::ProcessCanonCustom($newTagTable, $dirData, $subdirStart, $size);
                    $verbose and print "........ End $tagStr ........\n";
                } else {
                    warn "ShortDir $tagStr is the wrong format (not short values)\n";
                }
            } elsif ($subdirType eq 'XMP') {
                my $xmpData = substr($$valueData, $subdirStart, $numItems);
                ProcessXMPDir($newTagTable, \$xmpData);
            } else {
                warn "Unknown TableType: $subdirType\n";
            }
            $swap_bytes = $oldSwap; # restore original byte swapping
            next;
        }
 #..............................................................................

        # save the value of this tag
        FoundTag($tagInfo, $value);
    }

    # check for directory immediately following this one
    if ($bytesFromEnd >= 4) {
        my $offset = Get32u($dataPt, $dirEnd);
        if ($offset) {
            my $subdirStart = $offsetBase + $offset;
            if ($subdirStart > $offsetBase+$exifLength) {
                warn "Illegal subdirectory link\n";
            } else {
                ProcessExifDir($tagTablePtr, $dataPt, $subdirStart,
                               $offsetBase, $exifLength, $nesting+1,
                               $fp) or $success = 0;
            }
        }
    } 
    return $success;
}

#------------------------------------------------------------------------------
# Process EXIF block
# Inputs: 0) Exif data reference, 1) data length (bytes)
# Returns: 1 on success, 0 on error
sub ProcessExif($$)
{
    my $dataPt = shift;
    my $length = shift;

    if ($length<6 or substr($$dataPt,0,6) ne "Exif\0\0") {
        # Hmmm.  Could be XMP, let's see
        if ($$dataPt =~ /<exif:/) {
            my $xmpTable = GetTagTable('TagTables::XMP::Main');
            $xmpTable and ProcessXMPDir($xmpTable, $dataPt) and return 1;
        }
        if ($$dataPt =~ /^http/) {
            $verbose and warn "Ignored Adobe EXIF garbage: length $length\n";
        } else {
            $verbose and warn "Ignored EXIF block length $length (bad header)\n";
        }
        return 0;
    }
    # get the data block (into a common variable)
    $exifData = substr($$dataPt, 6);

    # set byte ordering
    SetByteOrder(substr($exifData,0,2)) or return 0;

    # make sure our swapping works
    if (Get16u(\$exifData, 2) != 0x2a) {
        warn "Invalid Exif start\n";
        return 0;
    }

    my $firstOffset = Get32u(\$exifData, 4);

    return ProcessExifDir(GetTagTable('TagTables::Exif::Main'), \$exifData,
                          $firstOffset, 0, $length-4, 0);
}

#------------------------------------------------------------------------------
1;  # end
