exiftool.pm

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

{
    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