canonraw.pm

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

    binmode(RAW);
    $$inref = \*RAW;                    # save file reference for cleanup
    
    read(RAW,$buff,2)   or return 1;    # get byte order
    SetByteOrder($buff) or return 2;
    # set order for repacking binary data
    if ($buff eq 'MM') {
        $pk16 = 'n';      # big endian (Motorola/Network order)
        $pk32 = 'N';
    } else {
        $pk16 = 'v';      # little endian (Intel/Vax order)
        $pk32 = 'V'
    }
    read(RAW,$buff,4)   or return 1;    # get pointer to start of first block
    read(RAW,$sig,8)    or return 1;    # get file signature
    $sig eq "HEAPCCDR"  or return 3;    # validate signature
    my $blockStart = Get32u(\$buff);
    seek(RAW, 0, 2)     or return 4;    # seek to end of file
    my $blockEnd = tell(RAW)  or return 5;  # get file size (end of main block)
    seek(RAW, $blockEnd-4, 0) or return 4;
    read(RAW, $buff, 4) or return 1;    # get offset to directory start
    my $dirStart = Get32u(\$buff) + $blockStart;
    seek(RAW, $dirStart, 0) or return 4;
    read(RAW, $buff, 2) or return 1;
    my $dirEntries = Get16u(\$buff);    # number of directory entries
    read(RAW, $mainDir, $dirEntries * 10) or return 1;    # read entire directory
    for (my $i=0; $i<$dirEntries; ++$i) {
        my $offset = $i * 10;
        my $tag = Get16u(\$mainDir, $offset);
        next unless $tag == 0x2007;     # look for JPG tag
        $jpgLen = Get32u(\$mainDir, $offset + 2);
        $jpgPtr = Get32u(\$mainDir, $offset + 6) + $blockStart;
        $$outJpgLen = $jpgLen;          # we found the embedded JPG!
        last;
    }
    # nothing to do if outfile is the same as infile and no JPG data
    return 0 if $in_place and not $jpgLen;
    
    seek(RAW, 0, 0) or return 5;        # rewind to start of input file
    open(OUT,">$outfile") or return 10;
    binmode(OUT);
    $$outref = \*OUT;                   # save reference for cleanup

    if ($jpgLen) {
        # copy the RAW file, removing the JPG image
        read(RAW, $buff, $blockStart) or return 1;
        print OUT $buff or return 11;
        my $newDir = pack($pk16, $dirEntries-1);
        for (my $i=0; $i<$dirEntries; ++$i) {
            my $offset = $i * 10;
            my $tag = Get16u(\$mainDir, $offset);
            next if $tag == 0x2007;     # don't copy JPG preview
            my $type = $tag >> 8;
            # make sure the block type is something we know how to deal with
            return 9 unless $type == 0x20 or $type == 0x28 or $type == 0x30;
            # get the data length and position
            my $len = Get32u(\$mainDir, $offset + 2);
            my $ptr = Get32u(\$mainDir, $offset + 6) + $blockStart;
            # read the data block
            seek(RAW, $ptr, 0) or return 5;
            read(RAW, $buff, $len) or return 1;
            # we must shift this pointer if it comes after the JPG
            $ptr -= $jpgLen if $ptr > $jpgPtr;
            # construct new directory entry
            $newDir .= pack($pk16, $tag) . pack($pk32, $len) . 
                       pack($pk32, $ptr-$blockStart);
            # write the block
            seek(OUT, $ptr, 0) or return 12;
            print OUT $buff or return 11;
        }
        # with current RAW files the main directory is at the end, but
        # do the test anyway in case this changes in the future
        $dirStart -= $jpgLen if $dirStart > $jpgPtr;
        seek(OUT, $dirStart, 0) or return 12;
        # write the main directory
        print OUT $newDir or return 11;
        $buff = pack($pk32, $dirStart - $blockStart);
        # we should already be at the end of file, but we seek there
        # anyway to be safe in case the main directory moves in future
        # versions of Canon RAW files
        seek(OUT, 0, 2) or return 12;   # seek to end of file
        # write the main directory pointer (last thing in file)
        print OUT $buff or return 11;
    } else {
        # do a straight copy of the file
        my $len;
        while ($len = read(OUT, $buff, 65536)) {
            print OUT $buff or return 11;
        }
        return 1 unless defined $len;
    }
    return 0;               # file copied OK
}

#------------------------------------------------------------------------------
# Rewrite a Canon RAW (.CRW) file, removing embedded JPG preview image
# Inputs: 0) source file name, 1) dest file name (or undef to clean in place)
# Returns: 0=failure, 1=success, >1 size of JPG removed
# Note: This is a convenience routine, not used by exiftool
sub CleanRaw($;$)
{
    my $infile = shift;
    my $outfile = shift;
    my $in_place;   # flag that file is being modified in place
    my $inref;      # reference to input file
    my $outref;     # reference to output file
    my $jpgLen;
    my $err;
    
    # generate temporary file name if changing the file in-place
    unless ($outfile and $outfile ne $infile) {
        $outfile = "$infile-CleanRaw.tmp";      # write to temporary file
        $in_place = 1;                          # set in-place flag
    }
    if (-e $outfile) {
        $err = 20;  # don't overwrite existing file
    } else {
        $err = _doCleanRaw($infile, $outfile, $in_place, \$inref, \$outref, \$jpgLen);
    }
    # clean up any open files
    if ($inref) {
        close $inref or $err = 21;
    }
    if ($outref) {
        close $outref or $err = 22;
        if ($in_place and not $err) {
            # replace the original file only if everything went OK
            rename $outfile, $infile or $err = 23;
        }
        # erase bad (or dummy) output file
        unlink $outfile if $err;
    }
    # return success code
    if ($err) {
        warn "CleanRaw() error $err for $infile\n";
        return 0;
    } elsif ($jpgLen) {
        return $jpgLen;
    } else {
        return 1;
    }
}

#------------------------------------------------------------------------------
# Process Raw file directory
# Inputs: 0) file pointer, 1) block start position in file, 2) block size, 3) list tags to return
# Returns: 1 on success
sub ProcessRawDir($$$$)
{
    my $fp = shift;
    my $blockStart = shift;
    my $blockSize = shift;
    my $requestedTags = shift;
    my $buff;

    my $rawTagTable = ExifTool::GetTagTable('TagTables::CanonRaw::Main') or return 0;
    
    $ExifTool::verbose > 2 and printf("Raw block: start 0x%x, size 0x%x\n",$blockStart,$blockSize);
    # 4 bytes at end of block give directory position within block
    seek($fp, $blockStart+$blockSize-4, 0) or return 0;
    read($fp, $buff, 4) or return 0;
    my $dirOffset = ExifTool::Get32u(\$buff,0) + $blockStart;
    seek($fp, $dirOffset, 0) or return 0;
    read($fp, $buff, 2) or return 0;
    my $entries = ExifTool::Get16u(\$buff,0);   # get number of entries in directory
    my $dirLen = 10 * $entries;
    read($fp, $buff, $dirLen) or return 0;      # read the directory
    
    $ExifTool::verbose and printf("Raw directory at 0x%x with $entries entries:\n", $dirOffset);
    
    for (my $pt=0; $pt<$dirLen; $pt+=10) {
        my $tag = ExifTool::Get16u(\$buff, $pt);
        my $size = ExifTool::Get32u(\$buff, $pt+2);
        my $ptrVal = ExifTool::Get32u(\$buff,$pt+6);
        my $ptr = $ptrVal + $blockStart;        # all pointers relative to block start
        my $value;
        my $dumpHex;
        my $tagInfo = ExifTool::GetTagInfo($rawTagTable, $tag);
       
        $ExifTool::verbose > 1 and printf("Entry %d) Tag: 0x%.4x  Size: 0x%.8x  Ptr: 0x%.8x\n", $pt/10,$tag,$size,$ptr);
        my $tagType = $tag >> 8;    # tags are grouped in types by value of upper byte
        if ($tagType==0x28 or $tagType==0x30) {
            # this type of tag specifies a subdirectory
            $ExifTool::verbose and printf("........ Start 0x%x ........\n",$tag);
            ProcessRawDir($fp, $ptr, $size, $requestedTags);
            $ExifTool::verbose and printf("........ End 0x%x ........\n",$tag);
            next;
        } elsif ($tagType==0x48 or $tagType==0x50 or $tagType==0x58) {
            # this type of tag stores the value in the 'size' field (weird!)
            $value = $size;
        } elsif ($size == 0) {
            $value = $ptrVal;       # (haven't seen this, but this would make sense)
        } elsif ($size <= 512 or ($ExifTool::verbose > 2 and $size <= 65536)
            or ($tagInfo and ($$tagInfo{'SubDirectory'} 
            or grep(/^$$tagInfo{Name}$/i,@$requestedTags))))
        {
            # read value if size is small or specifically requested
            # or if this is a SubDirectory
            seek($fp, $ptr, 0) or return 0;
            unless (read($fp, $value, $size)) {
                warn sprintf("Error reading %d bytes from 0x%x\n",$size,$ptr);
                next;
            }
            $dumpHex = 1;
        } else {
            $value = sprintf("(%u bytes at 0x%x)",$size,$ptr);
        }
        if ($ExifTool::verbose > 1 or ($ExifTool::verbose and not defined $tagInfo)) {
            if ($dumpHex) {
                ExifTool::HexDumpTag($tag, \$value, $size);
            } else {
                printf("  Tag 0x%x: %s\n", $tag, ExifTool::Printable($value));
            }
        }
        next unless defined $tagInfo;
        
        my $subdir = $$tagInfo{'SubDirectory'};
        if ($subdir) {
            my $name = $$tagInfo{'Name'};
            my $newTagTable;
            if ($$subdir{'TagTable'}) {
                $newTagTable = ExifTool::GetTagTable($$subdir{'TagTable'});
                unless ($newTagTable) {
                    warn "Unknown tag table $$subdir{TagTable}\n";
                    next;
                }
            } else {
                warn "Must specify TagTable for SubDirectory $name\n";
                next;
            }
            my $subdirStart = 0;
            $$subdirStart = eval $$subdir{'Start'} if $$subdir{'Start'};
            my $dirData = \$value;
            my $subdirType = $$newTagTable{'TableType'};
            if (defined $$subdir{'Validate'} and not eval $$subdir{'Validate'}) {
                warn "Invalid $name data\n";
            } elsif ($subdirType) {
                $ExifTool::verbose and print "........ Start $name ........\n";
                if ($subdirType eq 'BinaryData') {
                    ExifTool::ProcessBinaryData($fp, $newTagTable, \$value, $subdirStart);
                } elsif ($subdirType eq 'CanonCustom') {
                    require TagTables::CanonCustom;
                    TagTables::CanonCustom::ProcessCanonCustom($newTagTable, \$value, $subdirStart, $size);
                } else {
                    warn "Bad SubDirectory type for RAW file: $subdirType\n";
                }
                $ExifTool::verbose and print "........ End $name ........\n";
            } else {
                warn "Must set TableType for $subdirType\n";
            }
        } else {
            ExifTool::FoundTag($tagInfo, $value);
        }
    }
    return 1;
}

#------------------------------------------------------------------------------
# get information from raw file
# Inputs: 0) file handle, 1) hash of tags to return
# Returns: 1 on success, 0 otherwise
sub RawInfo($$)
{
    my $RAW = shift;
    my $requestedTags = shift;
    my $buff;
    
    read($RAW,$buff,2) or return 0; 
    ExifTool::SetByteOrder($buff) or return 0;
    read($RAW,$buff,4) or return 0;
    my $hlen = ExifTool::Get32u(\$buff, 0);
    
    seek($RAW, 0, 2) or return 0;
    my $filesize = tell($RAW) or return 0;
    
    return ProcessRawDir($RAW, $hlen, $filesize-$hlen, $requestedTags);

    return 1;
}

1;  # end