exiftool.pm

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

    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