exiftool.pm

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

               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($$)