#------------------------------------------------------------------------------ # File: WriteExif.pl # # Description: Write EXIF meta information # # Revisions: 12/13/2004 - P. Harvey Created #------------------------------------------------------------------------------ package Image::ExifTool::Exif; use strict; use vars qw($VERSION $AUTOLOAD @formatSize @formatName %formatNumber %compression %photometricInterpretation %orientation); use Image::ExifTool::Fixup; sub InsertWritableProperties($$;$); # some information may be stored in different IFD's with the same meaning. # Use this lookup to decide when we should delete information that is stored # in another IFD when we write it to the preferred IFD. my %crossDelete = ( ExifIFD => 'IFD0', IFD0 => 'ExifIFD', ); # mandatory tag default values my %mandatory = ( IFD0 => { 0x011a => 72, # XResolution 0x011b => 72, # YResolution 0x0128 => 2, # ResolutionUnit (inches) 0x0213 => 1, # YCbCrPositioning (centered) # 0x8769 => ????, # ExifOffset }, IFD1 => { 0x0103 => 6, # Compression (JPEG) 0x011a => 72, # XResolution 0x011b => 72, # YResolution 0x0128 => 2, # ResolutionUnit (inches) }, ExifIFD => { 0x9000 => '0230', # ExifVersion 0x9101 => "1 2 3 0",# ComponentsConfiguration 0xa000 => '0100', # FlashpixVersion 0xa001 => 0xffff, # ColorSpace (uncalibrated) # 0xa002 => ????, # ExifImageWidth # 0xa003 => ????, # ExifImageHeight }, GPS => { 0x0000 => '2 3 0 0',# GPSVersionID }, InteropIFD => { 0x0002 => '0100', # InteropVersion }, ); # The main EXIF table is unique because the tags from this table may appear # in many different directories. For this reason, we introduce a # "WriteGroup" member to the tagInfo that tells us the preferred location # for writing each tag. Here is the lookup for Writable flag (format) # and WriteGroup for all writable tags # - WriteGroup is ExifIFD unless otherwise specified # - Protected is 1 if the tag shouldn't be copied with SetNewValuesFromFile() my %writeTable = ( 0x0001 => { # InteropIndex Protected => 1, Writable => 'string', WriteGroup => 'InteropIFD', }, 0x0002 => { # InteropVersion Protected => 1, Writable => 'undef', Mandatory => 1, WriteGroup => 'InteropIFD', }, 0x000b => { # ProcessingSoftware Writable => 'string', WriteGroup => 'IFD0', }, 0x00fe => { # SubfileType Protected => 1, Writable => 'int32u', WriteGroup => 'IFD0', }, 0x00ff => { # OldSubfileType Protected => 1, Writable => 'int16u', WriteGroup => 'IFD0', }, 0x0100 => { # ImageWidth Protected => 1, Writable => 'int32u', WriteGroup => 'IFD0', }, 0x0101 => { # ImageHeight Protected => 1, Writable => 'int32u', WriteGroup => 'IFD0', }, 0x0102 => { # BitsPerSample Protected => 1, Writable => 'int16u', WriteGroup => 'IFD0', Count => -1, # can be 1 or 3: -1 means 'variable' }, 0x0103 => { # Compression Protected => 1, Writable => 'int16u', WriteGroup => 'IFD0', Mandatory => 1, }, 0x0106 => { # PhotometricInterpretation Protected => 1, Writable => 'int16u', WriteGroup => 'IFD0', }, 0x0107 => { # Thresholding Protected => 1, Writable => 'int16u', WriteGroup => 'IFD0', }, 0x0108 => { # CellWidth Protected => 1, Writable => 'int16u', WriteGroup => 'IFD0', }, 0x0109 => { # CellLength Protected => 1, Writable => 'int16u', WriteGroup => 'IFD0', }, 0x010a => { # FillOrder Protected => 1, Writable => 'int16u', WriteGroup => 'IFD0', }, 0x010d => { # DocumentName Writable => 'string', WriteGroup => 'IFD0', }, 0x010e => { # ImageDescription Writable => 'string', WriteGroup => 'IFD0', }, 0x010f => { # Make Writable => 'string', WriteGroup => 'IFD0', }, 0x0110 => { # Model Writable => 'string', WriteGroup => 'IFD0', }, 0x0112 => { # Orientation Writable => 'int16u', WriteGroup => 'IFD0', }, 0x0115 => { # SamplesPerPixel Protected => 1, Writable => 'int16u', WriteGroup => 'IFD0', }, 0x0116 => { # RowsPerStrip Protected => 1, Writable => 'int32u', WriteGroup => 'IFD0', }, 0x0118 => { # MinSampleValue Writable => 'int16u', WriteGroup => 'IFD0', }, 0x0119 => { # MaxSampleValue Writable => 'int16u', WriteGroup => 'IFD0', }, 0x011a => { # XResolution Writable => 'rational64u', WriteGroup => 'IFD0', Mandatory => 1, }, 0x011b => { # YResolution Writable => 'rational64u', WriteGroup => 'IFD0', Mandatory => 1, }, 0x011c => { # PlanarConfiguration Protected => 1, Writable => 'int16u', WriteGroup => 'IFD0', }, 0x011d => { # PageName Writable => 'string', WriteGroup => 'IFD0', }, 0x011e => { # XPosition Writable => 'rational64u', WriteGroup => 'IFD0', }, 0x011f => { # YPosition Writable => 'rational64u', WriteGroup => 'IFD0', }, 0x0122 => { # GrayResponseUnit Writable => 'int16u', WriteGroup => 'IFD0', }, 0x0128 => { # ResolutionUnit Writable => 'int16u', WriteGroup => 'IFD0', Mandatory => 1, }, 0x0129 => { # PageNumber Writable => 'int16u', WriteGroup => 'IFD0', Count => 2, }, 0x012d => { # TransferFunction Protected => 1, Writable => 'int16u', WriteGroup => 'IFD0', Count => 768, }, 0x0131 => { # Software Writable => 'string', WriteGroup => 'IFD0', }, 0x0132 => { # ModifyDate Writable => 'string', Shift => 'Time', WriteGroup => 'IFD0', PrintConvInv => '$self->InverseDateTime($val,0)', }, 0x013b => { # Artist Writable => 'string', WriteGroup => 'IFD0', }, 0x013c => { # HostComputer Writable => 'string', WriteGroup => 'IFD0', }, 0x013d => { # Predictor Protected => 1, Writable => 'int16u', WriteGroup => 'IFD0', }, 0x013e => { # WhitePoint Writable => 'rational64u', WriteGroup => 'IFD0', Count => 2, }, 0x013f => { # PrimaryChromaticities Writable => 'rational64u', WriteGroup => 'IFD0', Count => 6, }, 0x0141 => { # HalftoneHints Writable => 'int16u', WriteGroup => 'IFD0', Count => 2, }, 0x0142 => { # TileWidth Protected => 1, Writable => 'int32u', WriteGroup => 'IFD0', }, 0x0143 => { # TileLength Protected => 1, Writable => 'int32u', WriteGroup => 'IFD0', }, 0x014c => { # InkSet Writable => 'int16u', WriteGroup => 'IFD0', }, 0x0150 => { # TargetPrinter Writable => 'string', WriteGroup => 'IFD0', }, 0x013c => { # HostComputer Writable => 'string', WriteGroup => 'IFD0', }, 0x0211 => { # YCbCrCoefficients Protected => 1, Writable => 'rational64u', WriteGroup => 'IFD0', Count => 3, }, 0x0212 => { # YCbCrSubSampling Protected => 1, Writable => 'int16u', WriteGroup => 'IFD0', Count => 2, }, 0x0213 => { # YCbCrPositioning Protected => 1, Writable => 'int16u', WriteGroup => 'IFD0', Mandatory => 1, }, 0x0214 => { # ReferenceBlackWhite Writable => 'rational64u', WriteGroup => 'IFD0', Count => 6, }, 0x1000 => { # RelatedImageFileFormat Protected => 1, Writable => 'string', WriteGroup => 'InteropIFD', }, 0x1001 => { # RelatedImageWidth Protected => 1, Writable => 'int16u', WriteGroup => 'InteropIFD', }, 0x1002 => { # RelatedImageHeight (more commonly RelatedImageLength) Protected => 1, Writable => 'int16u', WriteGroup => 'InteropIFD', }, 0x4746 => { # Rating (MicrosoftPhoto) Writable => 'int16u', WriteGroup => 'IFD0', Avoid => 1, }, 0x4749 => { # RatingPercent (MicrosoftPhoto) Writable => 'int16u', WriteGroup => 'IFD0', Avoid => 1, }, 0x828d => { # CFARepeatPatternDim Protected => 1, Writable => 'int16u', WriteGroup => 'SubIFD', Count => 2, }, 0x828e => { # CFAPattern2 Protected => 1, Writable => 'int8u', WriteGroup => 'SubIFD', Count => -1, }, 0x8298 => { # Copyright Writable => 'string', WriteGroup => 'IFD0', RawConvInv => '$val . "\0"', PrintConvInv => sub { my ($val, $self) = @_; # encode if necessary my $enc = $self->Options('CharsetEXIF'); $val = $self->Encode($val,$enc) if $enc and $val !~ /\0/; if ($val =~ /(.*?)\s*[\n\r]+\s*(.*)/s) { return $1 unless length $2; # photographer copyright set to ' ' if it doesn't exist, according to spec. return((length($1) ? $1 : ' ') . "\0" . $2); } return $val; }, }, # # Most of the tags below this belong in the ExifIFD... # 0x829a => { # ExposureTime Writable => 'rational64u', PrintConvInv => 'Image::ExifTool::Exif::ConvertFraction($val)', }, 0x829d => { # FNumber Writable => 'rational64u', PrintConvInv => '$val', }, 0x8546 => { # SEMInfo Writable => 'string', WriteGroup => 'IFD0', }, 0x87af => { # GeoTiffDirectory Writable => 'undef', WriteGroup => 'IFD0', # swap byte order if necessary RawConvInv => q{ return $val if length $val < 2; my $order = substr($val, -2); return $val unless $order eq 'II' or $order eq 'MM'; $val = substr($val, 0, -2); return $val if $order eq GetByteOrder(); return pack('v*',unpack('n*',$val)); }, }, 0x87b0 => { # GeoTiffDoubleParams Writable => 'undef', WriteGroup => 'IFD0', # swap byte order if necessary RawConvInv => q{ return $val if length $val < 2; my $order = substr($val, -2); return $val unless $order eq 'II' or $order eq 'MM'; $val = substr($val, 0, -2); return $val if $order eq GetByteOrder(); $val =~ s/(.{4})(.{4})/$2$1/sg; # swap words return pack('V*',unpack('N*',$val)); }, }, 0x87b1 => { # GeoTiffAsciiParams Writable => 'string', WriteGroup => 'IFD0', }, 0x8822 => 'int16u', # ExposureProgram 0x8824 => 'string', # SpectralSensitivity 0x8827 => { # ISO Writable => 'int16u', Count => -1, PrintConvInv => '$val=~tr/,//d; $val', }, 0x882a => { # TimeZoneOffset Writable => 'int16s', Count => -1, # can be 1 or 2 Notes => q{ 1 or 2 values: 1. The time zone offset of DateTimeOriginal from GMT in hours, 2. If present, the time zone offset of ModifyDate }, }, 0x882b => 'int16u', # SelfTimerMode 0x8830 => 'int16u', # SensitivityType 0x8831 => 'int32u', # StandardOutputSensitivity 0x8832 => 'int32u', # RecommendedExposureIndex 0x8833 => 'int32u', # ISOSpeed 0x8834 => 'int32u', # ISOSpeedLatitudeyyy 0x8835 => 'int32u', # ISOSpeedLatitudezzz 0x9000 => { # ExifVersion Writable => 'undef', Mandatory => 1, PrintConvInv => '$val=~tr/.//d; $val=~/^\d{4}$/ ? $val : undef', }, 0x9003 => { # DateTimeOriginal Writable => 'string', Shift => 'Time', PrintConvInv => '$self->InverseDateTime($val,0)', }, 0x9004 => { # CreateDate Writable => 'string', Shift => 'Time', PrintConvInv => '$self->InverseDateTime($val,0)', }, 0x9009 => 'undef', # GooglePlusUploadCode 0x9101 => { # ComponentsConfiguration Protected => 1, Writable => 'undef', Count => 4, Mandatory => 1, ValueConvInv => '$val=~tr/,//d; $val', # (so we can copy from XMP with -n) }, 0x9102 => { # CompressedBitsPerPixel Protected => 1, Writable => 'rational64u', }, 0x9201 => { # ShutterSpeedValue Writable => 'rational64s', ValueConvInv => '$val>0 ? -log($val)/log(2) : -100', PrintConvInv => 'Image::ExifTool::Exif::ConvertFraction($val)', }, 0x9202 => { # ApertureValue Writable => 'rational64u', ValueConvInv => '$val>0 ? 2*log($val)/log(2) : 0', PrintConvInv => '$val', }, 0x9203 => 'rational64s',# BrightnessValue 0x9204 => { # ExposureCompensation Writable => 'rational64s', PrintConvInv => 'Image::ExifTool::Exif::ConvertFraction($val)', }, 0x9205 => { # MaxApertureValue Writable => 'rational64u', ValueConvInv => '$val>0 ? 2*log($val)/log(2) : 0', PrintConvInv => '$val', }, 0x9206 => { # SubjectDistance Writable => 'rational64u', PrintConvInv => '$val=~s/\s*m$//;$val', }, 0x9207 => 'int16u', # MeteringMode 0x9208 => 'int16u', # LightSource 0x9209 => 'int16u', # Flash 0x920a => { # FocalLength Writable => 'rational64u', PrintConvInv => '$val=~s/\s*mm$//;$val', }, 0x9211 => 'int32u', # ImageNumber 0x9212 => 'string', # SecurityClassification 0x9213 => 'string', # ImageHistory 0x9214 => { # SubjectArea Writable => 'int16u', Count => -1, # 2, 3 or 4 values }, # 0x927c => 'undef', # MakerNotes 0x9286 => { # UserComment Writable => 'undef', # (starts with "ASCII\0\0\0", "UNICODE\0", "JIS\0\0\0\0\0" or "\0\0\0\0\0\0\0\0") RawConvInv => 'Image::ExifTool::Exif::EncodeExifText($self,$val)', # SHOULD ADD SPECIAL LOGIC TO ALLOW CONDITIONAL OVERWRITE OF # "UNKNOWN" VALUES FILLED WITH SPACES }, 0x9290 => { # SubSecTime Writable => 'string', # extract fractional seconds from a full date/time value ValueConvInv => '$val=~/^(\d+)\s*$/ ? $1 : ($val=~/\.(\d+)/ ? $1 : undef)', }, 0x9291 => { # SubSecTimeOriginal Writable => 'string', ValueConvInv => '$val=~/^(\d+)\s*$/ ? $1 : ($val=~/\.(\d+)/ ? $1 : undef)', }, 0x9292 => { # SubSecTimeDigitized Writable => 'string', ValueConvInv => '$val=~/^(\d+)\s*$/ ? $1 : ($val=~/\.(\d+)/ ? $1 : undef)', }, 0x935c => { # ImageSourceData Writable => 'undef', WriteGroup => 'IFD0', Protected => 1, }, # 0x9928 => 'undef', # Opto-ElectricConversionFactor 0x9c9b => { # XPTitle Writable => 'int8u', WriteGroup => 'IFD0', Notes => q{ tags 0x9c9b-0x9c9f are used by Windows Explorer; special characters in these values are converted to UTF-8 by default, or Windows Latin1 with the -L option. XPTitle is ignored by Windows Explorer if ImageDescription exists }, ValueConvInv => '$self->Encode($val,"UCS2","II") . "\0\0"', }, 0x9c9c => { # XPComment Writable => 'int8u', WriteGroup => 'IFD0', ValueConvInv => '$self->Encode($val,"UCS2","II") . "\0\0"', }, 0x9c9d => { # XPAuthor Writable => 'int8u', WriteGroup => 'IFD0', Notes => 'ignored by Windows Explorer if Artist exists', ValueConvInv => '$self->Encode($val,"UCS2","II") . "\0\0"', }, 0x9c9e => { # XPKeywords Writable => 'int8u', WriteGroup => 'IFD0', ValueConvInv => '$self->Encode($val,"UCS2","II") . "\0\0"', }, 0x9c9f => { # XPSubject Writable => 'int8u', WriteGroup => 'IFD0', ValueConvInv => '$self->Encode($val,"UCS2","II") . "\0\0"', }, 0xa000 => { # FlashpixVersion Writable => 'undef', Mandatory => 1, PrintConvInv => '$val=~tr/.//d; $val=~/^\d{4}$/ ? $val : undef', }, 0xa001 => { # ColorSpace Writable => 'int16u', Mandatory => 1, }, 0xa002 => { # ExifImageWidth (could also be int32u) Writable => 'int16u', Mandatory => 1, }, 0xa003 => { # ExifImageHeight (could also be int32u) Writable => 'int16u', Mandatory => 1, }, 0xa004 => 'string', # RelatedSoundFile 0xa20b => { # FlashEnergy Writable => 'rational64u', Count => -1, # 1 or 2 (ref 12) }, # 0xa20c => 'undef', # SpatialFrequencyResponse 0xa20e => 'rational64u',# FocalPlaneXResolution 0xa20f => 'rational64u',# FocalPlaneYResolution 0xa210 => 'int16u', # FocalPlaneResolutionUnit 0xa214 => { # SubjectLocation Writable => 'int16u', Count => 2, }, 0xa215 => 'rational64u',# ExposureIndex 0xa217 => 'int16u', # SensingMethod 0xa300 => { # FileSource Writable => 'undef', ValueConvInv => '($val=~/^\d+$/ and $val < 256) ? chr($val) : $val', }, 0xa301 => { # SceneType Writable => 'undef', ValueConvInv => 'chr($val)', }, 0xa302 => { # CFAPattern Writable => 'undef', RawConvInv => q{ my @a = split ' ', $val; return $val if @a <= 2; # also accept binary data for backward compatibility return pack(GetByteOrder() eq 'II' ? 'v2C*' : 'n2C*', @a); }, PrintConvInv => 'Image::ExifTool::Exif::GetCFAPattern($val)', }, 0xa401 => 'int16u', # CustomRendered 0xa402 => 'int16u', # ExposureMode 0xa403 => 'int16u', # WhiteBalance 0xa404 => 'rational64u',# DigitalZoomRatio 0xa405 => { # FocalLengthIn35mmFormat Writable => 'int16u', PrintConvInv => '$val=~s/\s*mm$//;$val', }, 0xa406 => 'int16u', # SceneCaptureType 0xa407 => 'int16u', # GainControl 0xa408 => { # Contrast Writable => 'int16u', PrintConvInv => 'Image::ExifTool::Exif::ConvertParameter($val)', }, 0xa409 => { # Saturation Writable => 'int16u', PrintConvInv => 'Image::ExifTool::Exif::ConvertParameter($val)', }, 0xa40a => { # Sharpness Writable => 'int16u', PrintConvInv => 'Image::ExifTool::Exif::ConvertParameter($val)', }, # 0xa40b => 'undef', # DeviceSettingDescription 0xa40c => 'int16u', # SubjectDistanceRange 0xa420 => 'string', # ImageUniqueID 0xa430 => 'string', # OwnerName 0xa431 => 'string', # SerialNumber 0xa432 => { # LensInfo Writable => 'rational64u', Count => 4, PrintConvInv => \&ConvertLensInfo, }, 0xa433 => 'string', # LensMake 0xa434 => 'string', # LensModel 0xa435 => 'string', # LensSerialNumber 0xa500 => 'rational64u',# Gamma # # DNG stuff (mostly in IFD0, "Raw IFD" in SubIFD) # 0xc612 => { # DNGVersion Writable => 'int8u', WriteGroup => 'IFD0', Count => 4, Protected => 1, # (confuses Apple Preview if written to a TIFF image) PrintConvInv => '$val =~ tr/./ /; $val', }, 0xc613 => { # DNGBackwardVersion Writable => 'int8u', WriteGroup => 'IFD0', Count => 4, Protected => 1, PrintConvInv => '$val =~ tr/./ /; $val', }, 0xc614 => { # UniqueCameraModel Writable => 'string', WriteGroup => 'IFD0', }, 0xc615 => { # LocalizedCameraModel Writable => 'string', WriteGroup => 'IFD0', PrintConvInv => '$val', }, 0xc618 => { # LinearizationTable Writable => 'int16u', WriteGroup => 'SubIFD', Count => -1, Protected => 1, },, 0xc619 => { # BlackLevelRepeatDim Writable => 'int16u', WriteGroup => 'SubIFD', Count => 2, Protected => 1, }, 0xc61a => { # BlackLevel Writable => 'rational64u', WriteGroup => 'SubIFD', Count => -1, Protected => 1, }, 0xc61b => { # BlackLevelDeltaH Writable => 'rational64s', WriteGroup => 'SubIFD', Count => -1, Protected => 1, }, 0xc61c => { # BlackLevelDeltaV Writable => 'rational64s', WriteGroup => 'SubIFD', Count => -1, Protected => 1, }, 0xc61d => { # WhiteLevel Writable => 'int32u', WriteGroup => 'SubIFD', Count => -1, Protected => 1, }, 0xc61e => { # DefaultScale Writable => 'rational64u', WriteGroup => 'SubIFD', Count => 2, Protected => 1, }, 0xc61f => { # DefaultCropOrigin Writable => 'int32u', WriteGroup => 'SubIFD', Count => 2, Protected => 1, }, 0xc620 => { # DefaultCropSize Writable => 'int32u', WriteGroup => 'SubIFD', Count => 2, Protected => 1, }, 0xc621 => { # ColorMatrix1 Writable => 'rational64s', WriteGroup => 'IFD0', Count => -1, Protected => 1, }, 0xc622 => { # ColorMatrix2 Writable => 'rational64s', WriteGroup => 'IFD0', Count => -1, Protected => 1, }, 0xc623 => { # CameraCalibration1 Writable => 'rational64s', WriteGroup => 'IFD0', Count => -1, Protected => 1, }, 0xc624 => { # CameraCalibration2 Writable => 'rational64s', WriteGroup => 'IFD0', Count => -1, Protected => 1, }, 0xc625 => { # ReductionMatrix1 Writable => 'rational64s', WriteGroup => 'IFD0', Count => -1, Protected => 1, }, 0xc626 => { # ReductionMatrix2 Writable => 'rational64s', WriteGroup => 'IFD0', Count => -1, Protected => 1, }, 0xc627 => { # AnalogBalance Writable => 'rational64u', WriteGroup => 'IFD0', Count => -1, Protected => 1, }, 0xc628 => { # AsShotNeutral Writable => 'rational64u', WriteGroup => 'IFD0', Count => -1, Protected => 1, }, 0xc629 => { # AsShotWhiteXY Writable => 'rational64u', WriteGroup => 'IFD0', Count => 2, Protected => 1, }, 0xc62a => { # BaselineExposure Writable => 'rational64s', WriteGroup => 'IFD0', Protected => 1, }, 0xc62b => { # BaselineNoise Writable => 'rational64u', WriteGroup => 'IFD0', Protected => 1, }, 0xc62c => { # BaselineSharpness Writable => 'rational64u', WriteGroup => 'IFD0', Protected => 1, }, 0xc62d => { # BayerGreenSplit Writable => 'int32u', WriteGroup => 'SubIFD', Protected => 1, }, 0xc62e => { # LinearResponseLimit Writable => 'rational64u', WriteGroup => 'IFD0', Protected => 1, }, 0xc62f => { # CameraSerialNumber Writable => 'string', WriteGroup => 'IFD0', }, 0xc630 => { # DNGLensInfo Writable => 'rational64u', WriteGroup => 'IFD0', Count => 4, PrintConvInv => \&ConvertLensInfo, }, 0xc631 => { # ChromaBlurRadius Writable => 'rational64u', WriteGroup => 'SubIFD', Protected => 1, }, 0xc632 => { # AntiAliasStrength Writable => 'rational64u', WriteGroup => 'SubIFD', Protected => 1, }, 0xc633 => { # ShadowScale Writable => 'rational64u', WriteGroup => 'IFD0', Protected => 1, }, 0xc635 => { # MakerNoteSafety Writable => 'int16u', WriteGroup => 'IFD0', }, 0xc65a => { # CalibrationIlluminant1 Writable => 'int16u', WriteGroup => 'IFD0', Protected => 1, }, 0xc65b => { # CalibrationIlluminant2 Writable => 'int16u', WriteGroup => 'IFD0', Protected => 1, }, 0xc65c => { # BestQualityScale Writable => 'rational64u', WriteGroup => 'SubIFD', Protected => 1, }, 0xc65d => { # RawDataUniqueID Writable => 'int8u', WriteGroup => 'IFD0', Count => 16, Count => 16, ValueConvInv => 'pack("H*", $val)', Protected => 1, }, 0xc68b => { # OriginalRawFileName Writable => 'string', WriteGroup => 'IFD0', Protected => 1, }, 0xc68d => { # ActiveArea Writable => 'int32u', WriteGroup => 'SubIFD', Count => 4, Protected => 1, }, 0xc68e => { # MaskedAreas Writable => 'int32u', WriteGroup => 'SubIFD', Count => 4, Protected => 1, }, 0xc68f => { # AsShotICCProfile (writable directory) WriteGroup => 'IFD0', Protected => 1, WriteCheck => q{ require Image::ExifTool::ICC_Profile; return Image::ExifTool::ICC_Profile::ValidateICC(\$val); }, }, 0xc690 => { # AsShotPreProfileMatrix Writable => 'rational64s', WriteGroup => 'IFD0', Count => -1, Protected => 1, }, 0xc691 => { # CurrentICCProfile (writable directory) Writable => 'undef', WriteGroup => 'IFD0', Protected => 1, WriteCheck => q{ require Image::ExifTool::ICC_Profile; return Image::ExifTool::ICC_Profile::ValidateICC(\$val); }, }, 0xc692 => { # CurrentPreProfileMatrix Writable => 'rational64s', WriteGroup => 'IFD0', Count => -1, Protected => 1, }, 0xc6bf => { # ColorimetricReference Writable => 'int16u', WriteGroup => 'IFD0', Protected => 1, }, 0xc6d2 => { # PanasonicTitle (Panasonic DMC-TZ5, not a DNG tag) Writable => 'undef', WriteGroup => 'IFD0', ValueConvInv => '$self->Encode($val,"UTF8")', }, 0xc6d3 => { # PanasonicTitle2 (Panasonic DMC-FS7, not a DNG tag) Writable => 'undef', WriteGroup => 'IFD0', ValueConvInv => '$self->Encode($val,"UTF8")', }, 0xc6f3 => { # CameraCalibrationSig Writable => 'string', WriteGroup => 'IFD0', Protected => 1, }, 0xc6f4 => { # ProfileCalibrationSig Writable => 'string', WriteGroup => 'IFD0', Protected => 1, }, 0xc6f6 => { # AsShotProfileName Writable => 'string', WriteGroup => 'IFD0', Protected => 1, }, 0xc6f7 => { # NoiseReductionApplied Writable => 'rational64u', WriteGroup => 'SubIFD', Protected => 1, }, 0xc6f8 => { # ProfileName Writable => 'string', WriteGroup => 'IFD0', Protected => 1, }, 0xc6f9 => { # ProfileHueSatMapDims Writable => 'int32u', WriteGroup => 'IFD0', Count => 3, Protected => 1, }, 0xc6fa => { # ProfileHueSatMapData1 Writable => 'float', WriteGroup => 'IFD0', Count => -1, Protected => 1, }, 0xc6fb => { # ProfileHueSatMapData2 Writable => 'float', WriteGroup => 'IFD0', Count => -1, Protected => 1, }, 0xc6fc => { # ProfileToneCurve Writable => 'float', WriteGroup => 'IFD0', Count => -1, Protected => 1, }, 0xc6fd => { # ProfileEmbedPolicy Writable => 'int32u', WriteGroup => 'IFD0', Protected => 1, }, 0xc6fe => { # ProfileCopyright Writable => 'string', WriteGroup => 'IFD0', Protected => 1, }, 0xc714 => { # ForwardMatrix1 Writable => 'rational64s', WriteGroup => 'IFD0', Count => -1, Protected => 1, }, 0xc715 => { # ForwardMatrix2 Writable => 'rational64s', WriteGroup => 'IFD0', Count => -1, Protected => 1, }, 0xc716 => { # PreviewApplicationName Writable => 'string', WriteGroup => 'IFD0', Protected => 1, }, 0xc717 => { # PreviewApplicationVersion Writable => 'string', WriteGroup => 'IFD0', Protected => 1, }, 0xc718 => { # PreviewSettingsName Writable => 'string', WriteGroup => 'IFD0', Protected => 1, }, 0xc719 => { # PreviewSettingsDigest Writable => 'int8u', WriteGroup => 'IFD0', Protected => 1, ValueConvInv => 'pack("H*", $val)', }, 0xc71a => { # PreviewColorSpace Writable => 'int32u', WriteGroup => 'IFD0', Protected => 1, PrintConv => { 0 => 'Unknown', 1 => 'Gray Gamma 2.2', 2 => 'sRGB', 3 => 'Adobe RGB', 4 => 'ProPhoto RGB', }, }, 0xc71b => { # PreviewDateTime Writable => 'string', WriteGroup => 'IFD0', Protected => 1, ValueConvInv => q{ require Image::ExifTool::XMP; return Image::ExifTool::XMP::FormatXMPDate($val); }, PrintConvInv => '$self->InverseDateTime($val,1,1)', }, 0xc71c => { # RawImageDigest Writable => 'int8u', WriteGroup => 'IFD0', Count => 16, Protected => 1, ValueConvInv => 'pack("H*", $val)', }, 0xc71d => { # OriginalRawFileDigest Writable => 'int8u', WriteGroup => 'IFD0', Count => 16, Protected => 1, ValueConvInv => 'pack("H*", $val)', }, 0xc725 => { # ProfileLookTableDims Writable => 'int32u', WriteGroup => 'IFD0', Count => 3, Protected => 1, }, 0xc726 => { # ProfileLookTableData Writable => 'float', WriteGroup => 'IFD0', Count => -1, Protected => 1, }, 0xc761 => { # NoiseProfile Writable => 'double', WriteGroup => 'SubIFD', Count => -1, Protected => 1, }, 0xc763 => { # TimeCodes Writable => 'int8u', WriteGroup => 'IFD0', Count => -1, # (8 * number of time codes, max 10) ValueConvInv => q{ my @a = map hex, split /[. ]+/, $val; join ' ', @a; }, PrintConvInv => q{ my @a = split ' ', $val; my @v; foreach (@a) { my @td = reverse split /T/; my $tz = 0x39; # default to unknown timezone if ($td[0] =~ s/([-+])(\d+):(\d+)$//) { if ($3 == 0) { $tz = hex(($1 eq '-') ? $2 : 0x26 - $2); } elsif ($3 == 30) { if ($1 eq '-') { $tz = $2 + 0x0a; $tz += 0x0a if $tz > 0x0f; } else { $tz = 0x3f - $2; $tz -= 0x0a if $tz < 0x3a; } } elsif ($3 == 45) { $tz = 0x32 if $1 eq '+' and $2 == 12; } } my @t = split /[:.]/, $td[0]; push @t, '00' while @t < 4; my $bg; if ($td[1]) { # date was specified: fill in date & timezone my @d = split /[-]/, $td[1]; next if @d < 3; $bg = sprintf('.%.2d.%.2d.%.2d.%.2x', $d[2], $d[1], $d[0]%100, $tz); $t[0] = sprintf('%.2x', hex($t[0]) + 0xc0); # set BGF1+BGF2 } else { # time only $bg = '.00.00.00.00'; } push @v, join('.', reverse(@t[0..3])) . $bg; } join ' ', @v; }, }, 0xc764 => { # FrameRate Writable => 'rational64s', WriteGroup => 'IFD0', PrintConvInv => '$val', }, 0xc772 => { # TStop Writable => 'rational64u', WriteGroup => 'IFD0', Count => -1, # (1 or 2) PrintConvInv => '$val=~tr/-/ /; $val', }, 0xc789 => { # ReelName Writable => 'string', WriteGroup => 'IFD0', }, 0xc791 => { # OriginalDefaultFinalSize Writable => 'int32u', WriteGroup => 'IFD0', Count => 2, Protected => 1, }, 0xc792 => { # OriginalBestQualitySize Writable => 'int32u', WriteGroup => 'IFD0', Count => 2, Protected => 1, }, 0xc793 => { # OriginalDefaultCropSize Writable => 'rational64u', WriteGroup => 'IFD0', Count => 2, Protected => 1, }, 0xc7a1 => { # CameraLabel Writable => 'string', WriteGroup => 'IFD0', }, 0xc7a3 => { # ProfileHueSatMapEncoding Writable => 'int32u', WriteGroup => 'IFD0', Protected => 1, }, 0xc7a4 => { # ProfileLookTableEncoding Writable => 'int32u', WriteGroup => 'IFD0', Protected => 1, }, 0xc7a5 => { # BaselineExposureOffset Writable => 'rational64s', # (incorrectly "RATIONAL" in DNG 1.4 spec) WriteGroup => 'IFD0', Protected => 1, }, 0xc7a6 => { # DefaultBlackRender Writable => 'int32u', WriteGroup => 'IFD0', Protected => 1, }, 0xc7a7 => { # NewRawImageDigest Writable => 'int8u', WriteGroup => 'IFD0', Count => 16, Protected => 1, ValueConvInv => 'pack("H*", $val)', }, 0xc7a8 => { # RawToPreviewGain Writable => 'double', WriteGroup => 'IFD0', Protected => 1, }, 0xc7b5 => { # DefaultUserCrop Writable => 'rational64u', WriteGroup => 'SubIFD', Count => 4, Protected => 1, }, # --- end DNG tags --- 0xea1d => { # OffsetSchema Writable => 'int32s', }, # tags produced by Photoshop Camera RAW # (avoid creating these tags unless there is no other option) 0xfde8 => { Name => 'OwnerName', Condition => '$$self{TIFF_TYPE} ne "DCR"', # (used for another purpose in Kodak DCR images) Avoid => 1, PSRaw => 1, Writable => 'string', ValueConv => '$val=~s/^.*: //;$val', ValueConvInv => q{"Owner's Name: $val"}, Notes => q{ tags 0xfde8-0xfdea and 0xfe4c-0xfe58 are generated by Photoshop Camera RAW. Some names are the same as other EXIF tags, but ExifTool will avoid writing these unless they already exist in the file }, }, 0xfde9 => { Name => 'SerialNumber', Condition => '$$self{TIFF_TYPE} ne "DCR"', # (used for another purpose in Kodak DCR SubIFD) Avoid => 1, PSRaw => 1, Writable => 'string', ValueConv => '$val=~s/^.*: //;$val', ValueConvInv => q{"Serial Number: $val"}, }, 0xfdea => { Name => 'Lens', Condition => '$$self{TIFF_TYPE} ne "DCR"', # (used for another purpose in Kodak DCR SubIFD) Avoid => 1, PSRaw => 1, Writable => 'string', ValueConv => '$val=~s/^.*: //;$val', ValueConvInv => q{"Lens: $val"}, }, 0xfe4c => { Name => 'RawFile', Avoid => 1, PSRaw => 1, Writable => 'string', ValueConv => '$val=~s/^.*: //;$val', ValueConvInv => q{"Raw File: $val"}, }, 0xfe4d => { Name => 'Converter', Avoid => 1, PSRaw => 1, Writable => 'string', ValueConv => '$val=~s/^.*: //;$val', ValueConvInv => q{"Converter: $val"}, }, 0xfe4e => { Name => 'WhiteBalance', Avoid => 1, PSRaw => 1, Writable => 'string', ValueConv => '$val=~s/^.*: //;$val', ValueConvInv => q{"White Balance: $val"}, }, 0xfe51 => { Name => 'Exposure', Avoid => 1, PSRaw => 1, Writable => 'string', ValueConv => '$val=~s/^.*: //;$val', ValueConvInv => q{"Exposure: $val"}, }, 0xfe52 => { Name => 'Shadows', Avoid => 1, PSRaw => 1, Writable => 'string', ValueConv => '$val=~s/^.*: //;$val', ValueConvInv => q{"Shadows: $val"}, }, 0xfe53 => { Name => 'Brightness', Avoid => 1, PSRaw => 1, Writable => 'string', ValueConv => '$val=~s/^.*: //;$val', ValueConvInv => q{"Brightness: $val"}, }, 0xfe54 => { Name => 'Contrast', Avoid => 1, PSRaw => 1, Writable => 'string', ValueConv => '$val=~s/^.*: //;$val', ValueConvInv => q{"Contrast: $val"}, }, 0xfe55 => { Name => 'Saturation', Avoid => 1, PSRaw => 1, Writable => 'string', ValueConv => '$val=~s/^.*: //;$val', ValueConvInv => q{"Saturation: $val"}, }, 0xfe56 => { Name => 'Sharpness', Avoid => 1, PSRaw => 1, Writable => 'string', ValueConv => '$val=~s/^.*: //;$val', ValueConvInv => q{"Sharpness: $val"}, }, 0xfe57 => { Name => 'Smoothness', Avoid => 1, PSRaw => 1, Writable => 'string', ValueConv => '$val=~s/^.*: //;$val', ValueConvInv => q{"Smoothness: $val"}, }, 0xfe58 => { Name => 'MoireFilter', Avoid => 1, PSRaw => 1, Writable => 'string', ValueConv => '$val=~s/^.*: //;$val', ValueConvInv => q{"Moire Filter: $val"}, }, ); # insert our writable properties into main EXIF tag table InsertWritableProperties(\%Image::ExifTool::Exif::Main, \%writeTable, \&CheckExif); #------------------------------------------------------------------------------ # Inverse print conversion for LensInfo # Inputs: 0) lens info string # Returns: PrintConvInv of string sub ConvertLensInfo($) { my $val = shift; my @a = GetLensInfo($val, 1); # (allow unknown "?" values) return @a ? join(' ', @a) : $val; } #------------------------------------------------------------------------------ # Get binary CFA Pattern from a text string # Inputs: Print-converted CFA pattern (eg. '[Blue,Green][Green,Red]') # Returns: CFA pattern as a string of numbers sub GetCFAPattern($) { my $val = shift; my @rows = split /\]\s*\[/, $val; @rows or warn("Rows not properly bracketed by '[]'\n"), return undef; my @cols = split /,/, $rows[0]; @cols or warn("Colors not separated by ','\n"), return undef; my $ny = @cols; my @a = (scalar(@rows), scalar(@cols)); my %cfaLookup = (red=>0, green=>1, blue=>2, cyan=>3, magenta=>4, yellow=>5, white=>6); my $row; foreach $row (@rows) { @cols = split /,/, $row; @cols == $ny or warn("Inconsistent number of colors in each row\n"), return undef; foreach (@cols) { tr/ \]\[//d; # remove remaining brackets and any spaces my $c = $cfaLookup{lc($_)}; defined $c or warn("Unknown color '$_'\n"), return undef; push @a, $c; } } return "@a"; } #------------------------------------------------------------------------------ # validate raw values for writing # Inputs: 0) ExifTool ref, 1) tagInfo hash ref, 2) raw value ref # Returns: error string or undef (and possibly changes value) on success sub CheckExif($$$) { my ($et, $tagInfo, $valPtr) = @_; my $format = $$tagInfo{Format} || $$tagInfo{Writable} || $$tagInfo{Table}{WRITABLE}; if (not $format or $format eq '1') { if ($$tagInfo{Groups}{0} eq 'MakerNotes') { return undef; # OK to have no format for makernotes } else { return 'No writable format'; } } return Image::ExifTool::CheckValue($valPtr, $format, $$tagInfo{Count}); } #------------------------------------------------------------------------------ # encode exif ASCII/Unicode text from UTF8 or Latin # Inputs: 0) ExifTool ref, 1) text string # Returns: encoded string # Note: MUST be called Raw conversion time so the EXIF byte order is known! sub EncodeExifText($$) { my ($et, $val) = @_; # does the string contain special characters? if ($val =~ /[\x80-\xff]/) { my $order = $et->GetNewValue('ExifUnicodeByteOrder'); return "UNICODE\0" . $et->Encode($val,'UTF16',$order); } else { return "ASCII\0\0\0$val"; } } #------------------------------------------------------------------------------ # insert writable properties into main tag table # Inputs: 0) tag table ref, 1) reference to writable properties # 2) [optional] CHECK_PROC reference sub InsertWritableProperties($$;$) { my ($tagTablePtr, $writeTablePtr, $checkProc) = @_; my $tag; $checkProc and $$tagTablePtr{CHECK_PROC} = $checkProc; foreach $tag (keys %$writeTablePtr) { my $writeInfo = $$writeTablePtr{$tag}; my @infoList = GetTagInfoList($tagTablePtr, $tag); if (@infoList) { my $tagInfo; foreach $tagInfo (@infoList) { if (ref $writeInfo) { my $key; foreach $key (keys %$writeInfo) { $$tagInfo{$key} = $$writeInfo{$key} unless defined $$tagInfo{$key}; } } else { $$tagInfo{Writable} = $writeInfo unless defined $$tagInfo{Writable}; } } } else { AddTagToTable($tagTablePtr, $tag, $writeInfo); } } } #------------------------------------------------------------------------------ # rebuild maker notes to properly contain all value data # (some manufacturers put value data outside maker notes!!) # Inputs: 0) ExifTool object ref, 1) tag table ref, 2) dirInfo ref # Returns: new maker note data (and creates MAKER_NOTE_FIXUP), or undef on error sub RebuildMakerNotes($$$) { my ($et, $tagTablePtr, $dirInfo) = @_; my $dirStart = $$dirInfo{DirStart}; my $dirLen = $$dirInfo{DirLen}; my $dataPt = $$dirInfo{DataPt}; my $dataPos = $$dirInfo{DataPos} || 0; my $rtnValue; my %subdirInfo = %$dirInfo; delete $$et{MAKER_NOTE_FIXUP}; # don't need to rebuild text, BinaryData or PreviewImage maker notes my $tagInfo = $$dirInfo{TagInfo}; my $subdir = $$tagInfo{SubDirectory}; my $proc = $$subdir{ProcessProc} || $$tagTablePtr{PROCESS_PROC} || \&ProcessExif; if (($proc ne \&ProcessExif and $$tagInfo{Name} =~ /Text/) or $proc eq \&Image::ExifTool::ProcessBinaryData or ($$tagInfo{PossiblePreview} and $dirLen > 6 and substr($$dataPt, $dirStart, 3) eq "\xff\xd8\xff")) { return substr($$dataPt, $dirStart, $dirLen); } my $saveOrder = GetByteOrder(); my $loc = Image::ExifTool::MakerNotes::LocateIFD($et,\%subdirInfo); if (defined $loc) { my $makerFixup = $subdirInfo{Fixup} = new Image::ExifTool::Fixup; # create new exiftool object to rewrite the directory without changing it my $newTool = new Image::ExifTool; $newTool->Options( IgnoreMinorErrors => $$et{OPTIONS}{IgnoreMinorErrors}, FixBase => $$et{OPTIONS}{FixBase}, ); $newTool->Init(); # must do this before calling WriteDirectory()! # don't copy over preview image $newTool->SetNewValue(PreviewImage => ''); # copy all transient members over in case they are used for writing # (Make, Model, etc) foreach (grep /[a-z]/, keys %$et) { $$newTool{$_} = $$et{$_}; } # fix base offsets if specified $newTool->Options(FixBase => $et->Options('FixBase')); # set GENERATE_PREVIEW_INFO flag so PREVIEW_INFO will be generated $$newTool{GENERATE_PREVIEW_INFO} = 1; # drop any large tags $$newTool{DROP_TAGS} = 1; # initialize other necessary data members $$newTool{FILE_TYPE} = $$et{FILE_TYPE}; $$newTool{TIFF_TYPE} = $$et{TIFF_TYPE}; # rewrite maker notes $rtnValue = $newTool->WriteDirectory(\%subdirInfo, $tagTablePtr); if (defined $rtnValue and length $rtnValue) { # add the dummy/empty preview image if necessary if ($$newTool{PREVIEW_INFO}) { $makerFixup->SetMarkerPointers(\$rtnValue, 'PreviewImage', length($rtnValue)); $rtnValue .= $$newTool{PREVIEW_INFO}{Data}; delete $$newTool{PREVIEW_INFO}; } # add makernote header if ($loc) { my $hdr = substr($$dataPt, $dirStart, $loc); # special case: convert Pentax/Samsung DNG maker notes to JPEG style # (in JPEG, Pentax makernotes are absolute and start with "AOC\0" for some # models, but in DNG images they are stored in tag 0xc634 of IFD0 and # start with either "PENTAX \0" or "SAMSUNG\0") if ($$dirInfo{Parent} eq 'IFD0' and $hdr =~ /^(PENTAX |SAMSUNG)\0/) { # convert to JPEG-style AOC maker notes if used by this model # (Note: this expression also appears in Exif.pm) if ($$et{Model} =~ /\b(K(-[57mrx]|(10|20|100|110|200)D|2000)|GX(10|20))\b/) { $hdr =~ s/^(PENTAX |SAMSUNG)\0/AOC\0/; # save fixup because AOC maker notes have absolute offsets $$et{MAKER_NOTE_FIXUP} = $makerFixup; } } $rtnValue = $hdr . $rtnValue; # adjust fixup for shift in start position $$makerFixup{Start} += length $hdr; } # shift offsets according to original position of maker notes, # and relative to the makernotes Base $$makerFixup{Shift} += $dataPos + $dirStart + $$dirInfo{Base} - $subdirInfo{Base}; # repair incorrect offsets if offsets were fixed $$makerFixup{Shift} += $subdirInfo{FixedBy} || 0; # fix up pointers to the specified offset $makerFixup->ApplyFixup(\$rtnValue); # save fixup information unless offsets were relative unless ($subdirInfo{Relative}) { # set shift so offsets are all relative to start of maker notes $$makerFixup{Shift} -= $dataPos + $dirStart; $$et{MAKER_NOTE_FIXUP} = $makerFixup; # save fixup for later } } } SetByteOrder($saveOrder); return $rtnValue; } #------------------------------------------------------------------------------ # Sort IFD directory entries # Inputs: 0) data reference, 1) directory start, 2) number of entries, # 3) flag to treat 0 as a valid tag ID (as opposed to an empty IFD entry) sub SortIFD($$$;$) { my ($dataPt, $dirStart, $numEntries, $allowZero) = @_; my ($index, %entries); # split the directory into separate entries for ($index=0; $index<$numEntries; ++$index) { my $entry = $dirStart + 2 + 12 * $index; my $tagID = Get16u($dataPt, $entry); my $entryData = substr($$dataPt, $entry, 12); # silly software can pad directories with zero entries -- put these at the end $tagID = 0x10000 unless $tagID or $index == 0 or $allowZero; # add new entry (allow for duplicate tag ID's, which shouldn't normally happen) if ($entries{$tagID}) { $entries{$tagID} .= $entryData; } else { $entries{$tagID} = $entryData; } } # sort the directory entries my @sortedTags = sort { $a <=> $b } keys %entries; # generate the sorted IFD my $newDir = ''; foreach (@sortedTags) { $newDir .= $entries{$_}; } # replace original directory with new, sorted one substr($$dataPt, $dirStart + 2, 12 * $numEntries) = $newDir; } #------------------------------------------------------------------------------ # Validate IFD entries (strict validation to test possible chained IFD's) # Inputs: 0) dirInfo ref (must have RAF set), 1) optional DirStart # Returns: true if IFD looks OK sub ValidateIFD($;$) { my ($dirInfo, $dirStart) = @_; my $raf = $$dirInfo{RAF} or return 0; my $base = $$dirInfo{Base}; $dirStart = $$dirInfo{DirStart} || 0 unless defined $dirStart; my $offset = $dirStart + ($$dirInfo{DataPos} || 0); my ($buff, $index); $raf->Seek($offset + $base, 0) and $raf->Read($buff,2) == 2 or return 0; my $numEntries = Get16u(\$buff,0); $numEntries > 1 and $numEntries < 64 or return 0; my $len = 12 * $numEntries; $raf->Read($buff, $len) == $len or return 0; my $lastID = -1; for ($index=0; $index<$numEntries; ++$index) { my $entry = 12 * $index; my $tagID = Get16u(\$buff, $entry); $tagID > $lastID or $$dirInfo{AllowOutOfOrderTags} or return 0; my $format = Get16u(\$buff, $entry+2); $format > 0 and $format <= 13 or return 0; my $count = Get32u(\$buff, $entry+4); $count > 0 or return 0; $lastID = $tagID; } return 1; } #------------------------------------------------------------------------------ # Get sorted list of offsets used in IFD # Inputs: 0) data ref, 1) directory start, 2) dataPos, 3) IFD entries, 4) tag table ref # Returns: 0) sorted list of offsets (only offsets after the end of the IFD) # 1) hash of list indices keyed by offset value # Notes: This is used in a patch to fix the count for tags in Kodak SubIFD3 sub GetOffList($$$$$) { my ($dataPt, $dirStart, $dataPos, $numEntries, $tagTablePtr) = @_; my $ifdEnd = $dirStart + 2 + 12 * $numEntries + $dataPos; my ($index, $offset, %offHash); for ($index=0; $index<$numEntries; ++$index) { my $entry = $dirStart + 2 + 12 * $index; my $format = Get16u($dataPt, $entry + 2); next if $format < 1 or $format > 13; my $count = Get16u($dataPt, $entry + 4); my $size = $formatSize[$format] * $count; if ($size <= 4) { my $tagID = Get16u($dataPt, $entry); next unless ref $$tagTablePtr{$tagID} eq 'HASH' and $$tagTablePtr{$tagID}{FixCount}; } my $offset = Get16u($dataPt, $entry + 8); $offHash{$offset} = 1 if $offset >= $ifdEnd; } # set offset hash values to indices in list my @offList = sort keys %offHash; $index = 0; foreach $offset (@offList) { $offHash{$offset} = $index++; } return(\@offList, \%offHash); } #------------------------------------------------------------------------------ # Update TIFF_END member if defined # Inputs: 0) ExifTool ref, 1) end of valid TIFF data sub UpdateTiffEnd($$) { my ($et, $end) = @_; if (defined $$et{TIFF_END} and $$et{TIFF_END} < $end) { $$et{TIFF_END} = $end; } } #------------------------------------------------------------------------------ # Handle error while writing EXIF # Inputs: 0) ExifTool ref, 1) error string, 2) tag table ref # Returns: undef on fatal error, or '' if minor error is ignored sub ExifErr($$$) { my ($et, $errStr, $tagTablePtr) = @_; # MakerNote errors are minor by default my $minor = ($$tagTablePtr{GROUPS}{0} eq 'MakerNotes'); if ($$tagTablePtr{VARS} and $$tagTablePtr{VARS}{MINOR_ERRORS}) { $et->Warn("$errStr. IFD dropped.") and return '' if $minor; $minor = 1; } return undef if $et->Error($errStr, $minor); return ''; } #------------------------------------------------------------------------------ # Read/Write IFD with TIFF-like header (used by DNG 1.2) # Inputs: 0) ExifTool object ref, 1) dirInfo ref, 2) tag table ref # Returns: Reading: 1 on success, otherwise returns 0 and sets a Warning # Writing: new data block or undef on error sub ProcessTiffIFD($$$) { my ($et, $dirInfo, $tagTablePtr) = @_; $et or return 1; # allow dummy access my $raf = $$dirInfo{RAF}; my $base = $$dirInfo{Base} || 0; my $dirName = $$dirInfo{DirName}; my $magic = $$dirInfo{Subdir}{Magic} || 0x002a; my $buff; # structured with a TIFF-like header and relative offsets $raf->Seek($base, 0) and $raf->Read($buff, 8) == 8 or return 0; unless (SetByteOrder(substr($buff,0,2)) and Get16u(\$buff, 2) == $magic) { my $msg = "Invalid $dirName header"; if ($$dirInfo{IsWriting}) { $et->Error($msg); return undef; } else { $et->Warn($msg); return 0; } } my $offset = Get32u(\$buff, 4); my %dirInfo = ( DirName => $$dirInfo{DirName}, Parent => $$dirInfo{Parent}, Base => $base, DataPt => \$buff, DataLen => length $buff, DataPos => 0, DirStart => $offset, DirLen => length($buff) - $offset, RAF => $raf, NewDataPos => 8, ); if ($$dirInfo{IsWriting}) { # rewrite the Camera Profile IFD my $newDir = WriteExif($et, \%dirInfo, $tagTablePtr); # don't add header if error writing directory ($newDir is undef) # or if directory is being deleted ($newDir is empty) return $newDir unless $newDir; # return directory with TIFF-like header return GetByteOrder() . Set16u($magic) . Set32u(8) . $newDir; } if ($$et{HTML_DUMP}) { my $tip = sprintf("Byte order: %s endian\nIdentifier: 0x%.4x\n%s offset: 0x%.4x", (GetByteOrder() eq 'II') ? 'Little' : 'Big', $magic, $dirName, $offset); $et->HDump($base, 8, "$dirName header", $tip, 0); } return ProcessExif($et, \%dirInfo, $tagTablePtr); } #------------------------------------------------------------------------------ # Write EXIF directory # Inputs: 0) ExifTool object ref, 1) source dirInfo ref, 2) tag table ref # Returns: Exif data block (may be empty if no Exif data) or undef on error # Notes: Increments ExifTool CHANGED flag for each tag changed. Also updates # TIFF_END if defined with location of end of original TIFF image. # Returns IFD data in the following order: # 1. IFD0 directory followed by its data # 2. SubIFD directory followed by its data, thumbnail and image # 3. GlobalParameters, EXIF, GPS, Interop IFD's each with their data # 4. IFD1,IFD2,... directories each followed by their data # 5. Thumbnail and/or image data for each IFD, with IFD0 image last sub WriteExif($$$) { my ($et, $dirInfo, $tagTablePtr) = @_; $et or return 1; # allow dummy access to autoload this package my $origDirInfo = $dirInfo; # save original dirInfo my $dataPt = $$dirInfo{DataPt}; unless ($dataPt) { my $emptyData = ''; $dataPt = \$emptyData; } my $dataPos = $$dirInfo{DataPos} || 0; my $dirStart = $$dirInfo{DirStart} || 0; my $dataLen = $$dirInfo{DataLen} || length($$dataPt); my $dirLen = $$dirInfo{DirLen} || ($dataLen - $dirStart); my $base = $$dirInfo{Base} || 0; my $firstBase = $base; my $raf = $$dirInfo{RAF}; my $dirName = $$dirInfo{DirName} || 'unknown'; my $fixup = $$dirInfo{Fixup} || new Image::ExifTool::Fixup; my $imageDataFlag = $$dirInfo{ImageData} || ''; my $verbose = $et->Options('Verbose'); my $out = $et->Options('TextOut'); my ($nextIfdPos, %offsetData, $inMakerNotes); my (@offsetInfo, %xDelete, $strEnc); my $deleteAll = 0; my $newData = ''; # initialize buffer to receive new directory data my @imageData; # image data blocks to copy later if requested my $name = $$dirInfo{Name}; $name = $dirName unless $name and $dirName eq 'MakerNotes' and $name !~ /^MakerNote/; # set encoding for strings $strEnc = $et->Options('CharsetEXIF') if $$tagTablePtr{GROUPS}{0} eq 'EXIF'; # allow multiple IFD's in IFD0-IFD1-IFD2... chain $$dirInfo{Multi} = 1 if $dirName =~ /^(IFD0|SubIFD)$/ and not defined $$dirInfo{Multi}; $inMakerNotes = 1 if $$tagTablePtr{GROUPS}{0} eq 'MakerNotes'; my $ifd; #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ # loop through each IFD # for ($ifd=0; ; ++$ifd) { # loop through multiple IFD's # save pointer to start of this IFD within the newData my $newStart = length($newData); my @subdirs; # list of subdirectory data and tag table pointers # determine if directory is contained within our data my $mustRead; if ($dirStart < 0 or $dirStart > $dataLen-2) { $mustRead = 1; } elsif ($dirLen > 2) { my $len = 2 + 12 * Get16u($dataPt, $dirStart); $mustRead = 1 if $dirStart + $len > $dataLen; } # read IFD from file if necessary if ($mustRead) { if ($raf) { # read the count of entries in this IFD my $offset = $dirStart + $dataPos; my ($buff, $buf2); unless ($raf->Seek($offset + $base, 0) and $raf->Read($buff,2) == 2) { return ExifErr($et, "Bad IFD or truncated file in $name", $tagTablePtr); } my $len = 12 * Get16u(\$buff,0); # (also read next IFD pointer if available) unless ($raf->Read($buf2, $len+4) >= $len) { return ExifErr($et, "Error reading $name", $tagTablePtr); } $buff .= $buf2; # make copy of dirInfo since we're going to modify it my %newDirInfo = %$dirInfo; $dirInfo = \%newDirInfo; # update directory parameters for the newly loaded IFD $dataPt = $$dirInfo{DataPt} = \$buff; $dirStart = $$dirInfo{DirStart} = 0; $dataPos = $$dirInfo{DataPos} = $offset; $dataLen = $$dirInfo{DataLen} = length $buff; $dirLen = $$dirInfo{DirLen} = $dataLen; # only account for nextIFD pointer if we are going to use it $len += 4 if $dataLen==$len+6 and ($$dirInfo{Multi} or $buff =~ /\0{4}$/); UpdateTiffEnd($et, $offset+$base+2+$len); } elsif ($dirLen) { # error if we can't load IFD (unless we are creating # from scratch, in which case dirLen will be zero) my $str = $et->Options('IgnoreMinorErrors') ? 'Deleted bad' : 'Bad'; $et->Error("$str $name directory", 1); } } my ($index, $dirEnd, $numEntries); if ($dirStart + 4 < $dataLen) { $numEntries = Get16u($dataPt, $dirStart); $dirEnd = $dirStart + 2 + 12 * $numEntries; if ($dirEnd > $dataLen) { return ExifErr($et, "Truncated $name directory", $tagTablePtr); } # sort entries if necessary (but not in maker notes IFDs) unless ($inMakerNotes) { my $lastID = -1; for ($index=0; $index<$numEntries; ++$index) { my $tagID = Get16u($dataPt, $dirStart + 2 + 12 * $index); # check for proper sequence (but ignore null entries at end) if ($tagID < $lastID and ($tagID or $$tagTablePtr{0})) { SortIFD($dataPt, $dirStart, $numEntries, $$tagTablePtr{0}); $et->Warn("Entries in $name were out of sequence. Fixed.",1); last; } $lastID = $tagID; } } } else { $numEntries = 0; $dirEnd = $dirStart; } # loop through new values and accumulate all information for this IFD my (%set, %mayDelete, $tagInfo); my $wrongDir = $crossDelete{$dirName}; foreach $tagInfo ($et->GetNewTagInfoList($tagTablePtr)) { my $tagID = $$tagInfo{TagID}; # evaluate conditional lists now if necessary if (ref $$tagTablePtr{$tagID} eq 'ARRAY' or $$tagInfo{Condition}) { my $curInfo = $et->GetTagInfo($tagTablePtr, $tagID); if (defined $curInfo and not $curInfo) { # need value to evaluate the condition my $val = $et->GetNewValue($tagInfo); # must convert to binary for evaluating in Condition if ($$tagInfo{Format} and defined $val) { $val = WriteValue($val, $$tagInfo{Format}, $$tagInfo{Count}); } if (defined $val) { my $fmt = $$tagInfo{Writable} || $$tagInfo{Format} || 'undef'; my $cnt = $$tagInfo{Count} || 1; # always use old format/count for Condition in maker notes if ($inMakerNotes) { for ($index=0; $index<$numEntries; ++$index) { my $entry = $dirStart + 2 + 12 * $index; my $id = Get16u($dataPt, $entry); if ($id eq $tagID) { my $f = Get16u($dataPt, $entry + 2); if ($formatName[$f]) { $fmt = $formatName[$f]; $cnt = Get32u($dataPt, $entry + 4); } last; } } } $curInfo = $et->GetTagInfo($tagTablePtr, $tagID, \$val, $fmt, $cnt); } else { # may want to delete this, but we need to see the value first $mayDelete{$tagID} = 1; } } # don't set this tag unless valid for the current condition next unless defined $curInfo and $curInfo eq $tagInfo; } if ($$tagInfo{WriteCondition}) { my $self = $et; # set $self to be used in eval #### eval WriteCondition ($self) unless (eval $$tagInfo{WriteCondition}) { $@ and warn $@; next; } } my $nvHash = $et->GetNewValueHash($tagInfo, $dirName); unless ($nvHash) { next unless $wrongDir; # delete stuff from the wrong directory if setting somewhere else $nvHash = $et->GetNewValueHash($tagInfo, $wrongDir); # don't cross delete if not overwriting next unless $et->IsOverwriting($nvHash); # don't cross delete if specifically deleting from the other directory # (Note: don't call GetValue() here because it shouldn't be called # if IsOverwriting returns < 0 -- eg. when shifting) next if not defined $$nvHash{Value} and $$nvHash{WantGroup} and lc($$nvHash{WantGroup}) eq lc($wrongDir); # remove this tag if found in this IFD $xDelete{$tagID} = 1; } if ($set{$tagID}) { # this tag is being set twice, which can happen if two Condition's # were true for this tag. Hopefully the only case where this can # happen is the MakerNotes tag since it may store two very different # types of information (MakerNotes and PreviewImage), but we want # to store the MakerNotes if both are available if ($tagID == 0x927c and $dirName =~ /^(ExifIFD|IFD0)$/) { next if $$tagInfo{Name} eq 'PreviewImage'; } else { $et->Warn(sprintf("Multiple new values for $name tag 0x%.4x",$tagID)); } } $set{$tagID} = $tagInfo; } # fix base offsets (some cameras incorrectly write maker notes in IFD0) if ($dirName eq 'MakerNotes' and $$dirInfo{Parent} =~ /^(ExifIFD|IFD0)$/ and $$et{TIFF_TYPE} !~ /^(ARW|SR2)$/ and not $$et{LeicaTrailerPos} and Image::ExifTool::MakerNotes::FixBase($et, $dirInfo)) { # update local variables from fixed values $base = $$dirInfo{Base}; $dataPos = $$dirInfo{DataPos}; } # initialize variables to handle mandatory tags my $mandatory = $mandatory{$dirName}; my ($allMandatory, $addMandatory); if ($mandatory) { # use X/Y resolution values from JFIF if available if ($dirName eq 'IFD0' and defined $$et{JFIFYResolution}) { my %ifd0Vals = %$mandatory; $ifd0Vals{0x011a} = $$et{JFIFXResolution}; $ifd0Vals{0x011b} = $$et{JFIFYResolution}; $ifd0Vals{0x0128} = $$et{JFIFResolutionUnit} + 1; $mandatory = \%ifd0Vals; } $allMandatory = $addMandatory = 0; # initialize to zero # add mandatory tags if creating a new directory unless ($numEntries) { foreach (keys %$mandatory) { $set{$_} or $set{$_} = $$tagTablePtr{$_}; } } } else { undef $deleteAll; # don't remove directory (no mandatory entries) } my ($addDirs, @newTags); if ($inMakerNotes) { $addDirs = { }; # can't currently add new directories in MakerNotes # allow non-permanent makernotes tags to be added # (note: we may get into trouble if there are too many of these # because we allow out-of-order tags in MakerNote IFD's but our # logic to add new tags relies on ordered entries) foreach (keys %set) { my $perm = $set{$_}{Permanent}; push @newTags, $_ if defined $perm and not $perm; } @newTags = sort { $a <=> $b } @newTags if @newTags > 1; } else { # get a hash of directories we will be writing in this one $addDirs = $et->GetAddDirHash($tagTablePtr, $dirName); # make a union of tags & dirs (can set whole dirs, like MakerNotes) my %allTags = ( %set, %$addDirs ); # make sorted list of new tags to be added @newTags = sort { $a <=> $b } keys(%allTags); } my $dirBuff = ''; # buffer for directory data my $valBuff = ''; # buffer for value data my @valFixups; # list of fixups for offsets in valBuff # fixup for offsets in dirBuff my $dirFixup = new Image::ExifTool::Fixup; my $entryBasedFixup; my $lastTagID = -1; my ($oldInfo, $oldFormat, $oldFormName, $oldCount, $oldSize, $oldValue, $oldImageData); my ($readFormat, $readFormName, $readCount); # format for reading old value(s) my ($entry, $valueDataPt, $valueDataPos, $valueDataLen, $valuePtr, $valEnd); my ($offList, $offHash, $ignoreCount, $fixCount); my $oldID = -1; my $newID = -1; # patch for Canon EOS 40D firmware 1.0.4 bug (incorrect directory counts) if ($inMakerNotes and $$et{Model} eq 'Canon EOS 40D') { my $fmt = Get16u($dataPt, $dirStart + 2 + 12 * ($numEntries - 1) + 2); if ($fmt < 1 or $fmt > 13) { # adjust the number of directory entries --$numEntries; $dirEnd -= 12; $ignoreCount = 1; } } #.............................................................................. # loop through entries in new directory # $index = 0; Entry: for (;;) { if (defined $oldID and $oldID == $newID) { # # read next entry from existing directory # if ($index < $numEntries) { $entry = $dirStart + 2 + 12 * $index; $oldID = Get16u($dataPt, $entry); $readFormat = $oldFormat = Get16u($dataPt, $entry+2); $readCount = $oldCount = Get32u($dataPt, $entry+4); undef $oldImageData; if ($oldFormat < 1 or $oldFormat > 13) { my $msg = "Bad format ($oldFormat) for $name entry $index"; # patch to preserve invalid directory entries in SubIFD3 of # various Kodak Z-series cameras (Z812, Z1085IS, Z1275) # and some Sony cameras such as the DSC-P10 if ($dirName eq 'MakerNotes' and (($$et{Make}=~/KODAK/i and $$dirInfo{Name} and $$dirInfo{Name} eq 'SubIFD3') or ($numEntries == 12 and $$et{Make} eq 'SONY' and $index >= 8))) { $dirBuff .= substr($$dataPt, $entry, 12); ++$index; $newID = $oldID; # we wrote this $et->Warn($msg, 1); next; } # don't write out null directory entry if ($oldFormat==0 and $index and $oldCount==0) { $ignoreCount = ($ignoreCount || 0) + 1; # must keep same directory size to avoid messing up our fixed offsets $dirBuff .= ("\0" x 12) if $$dirInfo{FixBase}; ++$index; $newID = $oldID; # pretend we wrote this next; } return ExifErr($et, $msg, $tagTablePtr); } $readFormName = $oldFormName = $formatName[$oldFormat]; $valueDataPt = $dataPt; $valueDataPos = $dataPos; $valueDataLen = $dataLen; $valuePtr = $entry + 8; # try direct method first for speed $oldInfo = $$tagTablePtr{$oldID}; if (ref $oldInfo ne 'HASH' or $$oldInfo{Condition}) { # must get unknown tags too # (necessary so we don't miss a tag we want to Drop) my $unk = $et->Options(Unknown => 1); $oldInfo = $et->GetTagInfo($tagTablePtr, $oldID); $et->Options(Unknown => $unk); } # patch incorrect count in Kodak SubIFD3 tags if ($oldCount < 2 and $oldInfo and $$oldInfo{FixCount}) { $offList or ($offList, $offHash) = GetOffList($dataPt, $dirStart, $dataPos, $numEntries, $tagTablePtr); my $i = $$offHash{Get32u($dataPt, $valuePtr)}; if (defined $i and $i < $#$offList) { $oldCount = int(($$offList[$i+1] - $$offList[$i]) / $formatSize[$oldFormat]); $fixCount = ($fixCount || 0) + 1 if $oldCount != $readCount; } } $oldSize = $oldCount * $formatSize[$oldFormat]; my $readFromFile; if ($oldSize > 4) { $valuePtr = Get32u($dataPt, $valuePtr); # fix valuePtr if necessary if ($$dirInfo{FixOffsets}) { $valEnd or $valEnd = $dataPos + $dirStart + 2 + 12 * $numEntries + 4; my ($tagID, $size, $wFlag) = ($oldID, $oldSize, 1); #### eval FixOffsets ($valuePtr, $valEnd, $size, $tagID, $wFlag) eval $$dirInfo{FixOffsets}; unless (defined $valuePtr) { unless ($$et{DROP_TAGS}) { my $tagStr = $oldInfo ? $$oldInfo{Name} : sprintf("tag 0x%.4x",$oldID); return undef if $et->Error("Bad $name offset for $tagStr", $inMakerNotes); } ++$index; $oldID = $newID; next; # drop this tag } } # offset shouldn't point into TIFF or IFD header my $suspect = ($valuePtr < 8); # convert offset to pointer in $$dataPt if ($$dirInfo{EntryBased} or (ref $$tagTablePtr{$oldID} eq 'HASH' and $$tagTablePtr{$oldID}{EntryBased})) { $valuePtr += $entry; } else { $valuePtr -= $dataPos; } # value shouldn't overlap our directory $suspect = 1 if $valuePtr < $dirEnd and $valuePtr+$oldSize > $dirStart; # get value by seeking in file if we are allowed if ($valuePtr < 0 or $valuePtr+$oldSize > $dataLen) { my ($pos, $tagStr, $invalidPreview, $tmpInfo, $leicaTrailer); if ($oldInfo) { $tagStr = $$oldInfo{Name}; $leicaTrailer = $$oldInfo{LeicaTrailer}; } elsif (defined $oldInfo) { $tmpInfo = $et->GetTagInfo($tagTablePtr, $oldID, \ '', $oldFormName, $oldCount); if ($tmpInfo) { $tagStr = $$tmpInfo{Name}; $leicaTrailer = $$tmpInfo{LeicaTrailer}; } } $tagStr or $tagStr = sprintf("tag 0x%.4x",$oldID); # allow PreviewImage to run outside EXIF segment in JPEG images if (not $raf) { if ($tagStr eq 'PreviewImage') { $raf = $$et{RAF}; if ($raf) { $pos = $raf->Tell(); if ($oldInfo and $$oldInfo{ChangeBase}) { # adjust base offset for this tag only #### eval ChangeBase ($dirStart,$dataPos) my $newBase = eval $$oldInfo{ChangeBase}; $valuePtr += $newBase; } } else { $invalidPreview = 1; } } elsif ($leicaTrailer) { # save information about Leica makernote trailer $$et{LeicaTrailer} = { TagInfo => $oldInfo || $tmpInfo, Offset => $base + $valuePtr + $dataPos, Size => $oldSize, Fixup => new Image::ExifTool::Fixup, }, $invalidPreview = 2; # remove SubDirectory to prevent processing (for now) my %copy = %{$oldInfo || $tmpInfo}; delete $copy{SubDirectory}; delete $copy{MakerNotes}; $oldInfo = \%copy; } } if ($oldSize > BINARY_DATA_LIMIT and $$origDirInfo{ImageData} and (not defined $oldInfo or ($oldInfo and not $$oldInfo{SubDirectory}))) { # copy huge data blocks later instead of loading into memory $oldValue = ''; # dummy empty value # copy this value later unless writing a new value unless ($set{$oldID}) { my $pad = $oldSize & 0x01 ? 1 : 0; # save block information to copy later (set directory offset later) $oldImageData = [$base+$valuePtr+$dataPos, $oldSize, $pad]; } } elsif ($raf) { my $success = ($raf->Seek($base+$valuePtr+$dataPos, 0) and $raf->Read($oldValue, $oldSize) == $oldSize); if (defined $pos) { $raf->Seek($pos, 0); undef $raf; # (sony A700 has 32-byte header on PreviewImage) unless ($success and $oldValue =~ /^(\xff\xd8\xff|(.|.{33})\xd8\xff\xdb)/s) { $invalidPreview = 1; $success = 1; # continue writing directory anyway } } unless ($success) { return undef if $et->Error("Error reading value for $name entry $index", $inMakerNotes); ++$index; $oldID = $newID; next; # drop this tag } } elsif (not $invalidPreview) { return undef if $et->Error("Bad $name offset for $tagStr", $inMakerNotes); ++$index; $oldID = $newID; next; # drop this tag } if ($invalidPreview) { # set value for invalid preview if ($$et{FILE_TYPE} eq 'JPEG') { # define dummy value for preview (or Leica MakerNote) to write later # (value must be larger than 4 bytes to generate PREVIEW_INFO, # and an even number of bytes so it won't be padded) $oldValue = 'LOAD_PREVIEW'; } else { $oldValue = 'none'; $oldSize = length $oldValue; } $valuePtr = 0; } else { UpdateTiffEnd($et, $base+$valuePtr+$dataPos+$oldSize); } # update pointers for value just read from file $valueDataPt = \$oldValue; $valueDataPos = $valuePtr + $dataPos; $valueDataLen = $oldSize; $valuePtr = 0; $readFromFile = 1; } if ($suspect) { my $tagStr = $oldInfo ? $$oldInfo{Name} : sprintf('tag 0x%.4x', $oldID); my $str = "Suspicious $name offset for $tagStr"; if ($inMakerNotes) { $et->Warn($str, 1); } else { return undef if $et->Error($str, 1); } } } # read value if we haven't already $oldValue = substr($$valueDataPt, $valuePtr, $oldSize) unless $readFromFile; # get tagInfo using value if necessary if (defined $oldInfo and not $oldInfo) { my $unk = $et->Options(Unknown => 1); $oldInfo = $et->GetTagInfo($tagTablePtr, $oldID, \$oldValue, $oldFormName, $oldCount); $et->Options(Unknown => $unk); # now that we have the value, we can resolve the Condition to finally # determine whether we want to delete this tag or not if ($mayDelete{$oldID} and $oldInfo and (not @newTags or $newTags[0] != $oldID)) { my $nvHash = $et->GetNewValueHash($oldInfo, $dirName); if (not $nvHash and $wrongDir) { # delete from wrong directory if necessary $nvHash = $et->GetNewValueHash($oldInfo, $wrongDir); $nvHash and $xDelete{$oldID} = 1; } if ($nvHash) { # we want to delete this tag after all, so insert it into our list $set{$oldID} = $oldInfo; unshift @newTags, $oldID; } } } # make sure we are handling the 'ifd' format properly if (($oldFormat == 13 or $oldFormat == 18) and (not $oldInfo or not $$oldInfo{SubIFD})) { my $str = sprintf('%s tag 0x%.4x IFD format not handled', $name, $oldID); $et->Error($str, $inMakerNotes); } # override format we use to read the value if specified if ($oldInfo) { # check for tags which must be integers if (($$oldInfo{IsOffset} or $$oldInfo{SubIFD}) and not $intFormat{$oldFormName}) { $et->Error("Invalid format ($oldFormName) for $name $$oldInfo{Name}", $inMakerNotes); ++$index; $oldID = $newID; next; # drop this tag } if ($$oldInfo{Drop} and $$et{DROP_TAGS} and ($$oldInfo{Drop} == 1 or $$oldInfo{Drop} < $oldSize)) { ++$index; $oldID = $newID; next; # drop this tag } if ($$oldInfo{Format}) { $readFormName = $$oldInfo{Format}; $readFormat = $formatNumber{$readFormName}; unless ($readFormat) { # we aren't reading in a standard EXIF format, so rewrite in old format $readFormName = $oldFormName; $readFormat = $oldFormat; } # adjust number of items to read if format size changed $readCount = $oldSize / $formatSize[$readFormat]; } } if ($oldID <= $lastTagID and not $inMakerNotes) { my $str = $oldInfo ? "$$oldInfo{Name} tag" : sprintf('tag 0x%x',$oldID); if ($oldID == $lastTagID) { $et->Warn("Duplicate $str in $name");; } else { $et->Warn("\u$str out of sequence in $name"); } } $lastTagID = $oldID; ++$index; # increment index for next time } else { undef $oldID; # no more existing entries } } # # write out all new tags, up to and including this one # $newID = $newTags[0]; my $isNew; # -1=tag is old, 0=tag same as existing, 1=tag is new if (not defined $oldID) { last unless defined $newID; $isNew = 1; } elsif (not defined $newID) { # maker notes will have no new tags defined if ($set{$oldID}) { $newID = $oldID; $isNew = 0; } else { $isNew = -1; } } else { $isNew = $oldID <=> $newID; } my $newInfo = $oldInfo; my $newFormat = $oldFormat; my $newFormName = $oldFormName; my $newCount = $oldCount; my $ifdFormName; my $newValue; my $newValuePt = $isNew >= 0 ? \$newValue : \$oldValue; my $isOverwriting; if ($isNew >= 0) { # add, edit or delete this tag shift @newTags; # remove from list if ($set{$newID}) { # # set the new tag value (or 'next' if deleting tag) # $newInfo = $set{$newID}; $newCount = $$newInfo{Count}; my ($val, $newVal, $n); my $nvHash = $et->GetNewValueHash($newInfo, $dirName); if ($isNew > 0) { # don't create new entry unless requested if ($nvHash) { next unless $$nvHash{IsCreating}; if ($$newInfo{IsOverwriting}) { my $proc = $$newInfo{IsOverwriting}; $isOverwriting = &$proc($et, $nvHash, $val, \$newVal); } else { $isOverwriting = $et->IsOverwriting($nvHash); } } else { next if $xDelete{$newID}; # don't create if cross deleting $newVal = $$mandatory{$newID}; # get value for mandatory tag $isOverwriting = 1; } # convert using new format if ($$newInfo{Format}) { $newFormName = $$newInfo{Format}; # use Writable flag to specify IFD format code $ifdFormName = $$newInfo{Writable}; } else { $newFormName = $$newInfo{Writable}; unless ($newFormName) { warn("No format for $name $$newInfo{Name}\n"); next; } } $newFormat = $formatNumber{$newFormName}; } elsif ($nvHash or $xDelete{$newID}) { unless ($nvHash) { $nvHash = $et->GetNewValueHash($newInfo, $wrongDir); } # read value if (length $oldValue >= $oldSize) { $val = ReadValue(\$oldValue, 0, $readFormName, $readCount, $oldSize); } else { $val = ''; } # determine write format (by default, use 'Writable' format) my $writable = $$newInfo{Writable}; # (or use existing format if 'Writable' not specified) $writable = $oldFormName unless $writable and $writable ne '1'; # (and override write format with 'Format' if specified) my $writeForm = $$newInfo{Format} || $writable; if ($writeForm ne $newFormName) { # write in specified format $newFormName = $writeForm; $newFormat = $formatNumber{$newFormName}; # use different IFD format code if necessary if ($inMakerNotes) { # always preserve IFD format in maker notes $ifdFormName = $oldFormName; } elsif ($writable ne $newFormName) { # use specified IFD format $ifdFormName = $writable; } } if ($inMakerNotes and $readFormName ne 'string' and $readFormName ne 'undef') { # keep same size in maker notes unless string or binary $newCount = $oldCount * $formatSize[$oldFormat] / $formatSize[$newFormat]; } if ($$newInfo{IsOverwriting}) { my $proc = $$newInfo{IsOverwriting}; $isOverwriting = &$proc($et, $nvHash, $val, \$newVal); } else { $isOverwriting = $et->IsOverwriting($nvHash, $val); } } if ($isOverwriting) { $newVal = $et->GetNewValue($nvHash) unless defined $newVal; # value undefined if deleting this tag # (also delete tag if cross-deleting and this isn't a date/time shift) if (not defined $newVal or ($xDelete{$newID} and not defined $$nvHash{Shift})) { if ($$newInfo{RawConvInv} and defined $$nvHash{Value}) { # error in RawConvInv, so rewrite existing tag goto NoOverwrite; # GOTO! } unless ($isNew) { ++$$et{CHANGED}; $et->VerboseValue("- $dirName:$$newInfo{Name}", $val); } next; } if ($newCount and $newCount < 0) { # set count to number of values if variable my @vals = split ' ',$newVal; $newCount = @vals; } # convert to binary format $newValue = WriteValue($newVal, $newFormName, $newCount); unless (defined $newValue) { $et->Warn("Invalid value for $dirName:$$newInfo{Name}"); goto NoOverwrite; # GOTO! } if (length $newValue) { # limit maximum value length in JPEG images # (max segment size is 65533 bytes and the min EXIF size is 96 incl an additional IFD entry) if ($$et{FILE_TYPE} eq 'JPEG' and length($newValue) > 65436 and $$newInfo{Name} ne 'PreviewImage') { my $name = $$newInfo{MakerNotes} ? 'MakerNotes' : $$newInfo{Name}; $et->Warn("$name too large to write in JPEG segment"); goto NoOverwrite; # GOTO! } # re-code if necessary if ($strEnc and $newFormName eq 'string') { $newValue = $et->Encode($newValue, $strEnc); } } else { $et->Warn("Can't write zero length $$newInfo{Name} in $$tagTablePtr{GROUPS}{1}"); goto NoOverwrite; # GOTO! } if ($isNew >= 0) { $newCount = length($newValue) / $formatSize[$newFormat]; ++$$et{CHANGED}; if (defined $allMandatory) { # not all mandatory if we are writing any tag specifically if ($nvHash) { undef $allMandatory; undef $deleteAll; } else { ++$addMandatory; # count mandatory tags that we added } } if ($verbose > 1) { $et->VerboseValue("- $dirName:$$newInfo{Name}", $val) unless $isNew; my $str = $nvHash ? '' : ' (mandatory)'; $et->VerboseValue("+ $dirName:$$newInfo{Name}", $newVal, $str); } } } else { NoOverwrite: next if $isNew > 0; $isNew = -1; # rewrite existing tag } # set format for EXIF IFD if different than conversion format if ($ifdFormName) { $newFormName = $ifdFormName; $newFormat = $formatNumber{$newFormName}; } } elsif ($isNew > 0) { # # create new subdirectory # # newInfo may not be defined if we try to add a mandatory tag # to a directory that doesn't support it (eg. IFD1 in RW2 images) $newInfo = $$addDirs{$newID} or next; # make sure we don't try to generate a new MakerNotes directory # or a SubIFD next if $$newInfo{MakerNotes} or $$newInfo{Name} eq 'SubIFD'; my $subTable; if ($$newInfo{SubDirectory}{TagTable}) { $subTable = Image::ExifTool::GetTagTable($$newInfo{SubDirectory}{TagTable}); } else { $subTable = $tagTablePtr; } # create empty source directory my %sourceDir = ( Parent => $dirName, Fixup => new Image::ExifTool::Fixup, ); $sourceDir{DirName} = $$newInfo{Groups}{1} if $$newInfo{SubIFD}; $newValue = $et->WriteDirectory(\%sourceDir, $subTable); # only add new directory if it isn't empty next unless defined $newValue and length($newValue); # set the fixup start location if ($$newInfo{SubIFD}) { # subdirectory is referenced by an offset in value buffer my $subdir = $newValue; $newValue = Set32u(0xfeedf00d); push @subdirs, { DataPt => \$subdir, Table => $subTable, Fixup => $sourceDir{Fixup}, Offset => length($dirBuff) + 8, Where => 'dirBuff', }; $newFormName = 'int32u'; $newFormat = $formatNumber{$newFormName}; } else { # subdirectory goes directly into value buffer $sourceDir{Fixup}{Start} += length($valBuff); # use Writable to set format, otherwise 'undef' $newFormName = $$newInfo{Writable}; unless ($newFormName and $formatNumber{$newFormName}) { $newFormName = 'undef'; } $newFormat = $formatNumber{$newFormName}; push @valFixups, $sourceDir{Fixup}; } } elsif ($$newInfo{Format} and $$newInfo{Writable} and $$newInfo{Writable} ne '1') { # use specified write format $newFormName = $$newInfo{Writable}; $newFormat = $formatNumber{$newFormName}; } elsif ($$addDirs{$newID} and $newInfo ne $$addDirs{$newID}) { # this can happen if we are trying to add a directory that doesn't exist # in this type of file (eg. try adding a SubIFD tag to an A100 image) $isNew = -1; } } if ($isNew < 0) { # just rewrite existing tag $newID = $oldID; $newValue = $oldValue; $newFormat = $oldFormat; # (just in case it changed) $newFormName = $oldFormName; # set offset of this entry in the directory so we can update the pointer # and save block information to copy this large block later if ($oldImageData) { $$oldImageData[3] = $newStart + length($dirBuff) + 2; push @imageData, $oldImageData; $$origDirInfo{ImageData} = \@imageData; } } if ($newInfo) { # # load necessary data for this tag (thumbnail image, etc) # if ($$newInfo{DataTag} and $isNew >= 0) { my $dataTag = $$newInfo{DataTag}; # load data for this tag unless (defined $offsetData{$dataTag} or $dataTag eq 'LeicaTrailer') { # prefer tag from Composite table if it exists (otherwise # PreviewImage data would be taken from Extra tag) my $compInfo = $Image::ExifTool::Composite{$dataTag}; $offsetData{$dataTag} = $et->GetNewValue($compInfo || $dataTag); my $err; if (defined $offsetData{$dataTag}) { my $len = length $offsetData{$dataTag}; if ($dataTag eq 'PreviewImage') { # must set DEL_PREVIEW flag now if preview fit into IFD $$et{DEL_PREVIEW} = 1 if $len <= 4; } elsif ($$et{FILE_TYPE} eq 'JPEG' and $len > 60000) { delete $offsetData{$dataTag}; $err = "$dataTag not written (too large for JPEG segment)"; } } else { $err = "$dataTag not found"; } if ($err) { $et->Warn($err) if $$newInfo{IsOffset}; delete $set{$newID}; # remove from list of tags we are setting next; } } } # # write maker notes # if ($$newInfo{MakerNotes}) { # don't write new makernotes if we are deleting this group if ($$et{DEL_GROUP}{MakerNotes} and ($$et{DEL_GROUP}{MakerNotes} != 2 or $isNew <= 0)) { if ($isNew <= 0) { ++$$et{CHANGED}; $verbose and print $out " Deleting MakerNotes\n"; } next; } my $saveOrder = GetByteOrder(); if ($isNew >= 0 and $set{$newID}) { # we are writing a whole new maker note block # --> add fixup information if necessary my $nvHash = $et->GetNewValueHash($newInfo, $dirName); if ($nvHash and $$nvHash{MAKER_NOTE_FIXUP}) { # must clone fixup because we will be shifting it my $makerFixup = $$nvHash{MAKER_NOTE_FIXUP}->Clone(); my $valLen = length($valBuff); $$makerFixup{Start} += $valLen; push @valFixups, $makerFixup; } } else { # update maker notes if possible my %subdirInfo = ( Base => $base, DataPt => $valueDataPt, DataPos => $valueDataPos, DataLen => $valueDataLen, DirStart => $valuePtr, DirLen => $oldSize, DirName => 'MakerNotes', Name => $$newInfo{Name}, Parent => $dirName, TagInfo => $newInfo, RAF => $raf, ); my ($subTable, $subdir, $loc, $writeProc, $notIFD); if ($$newInfo{SubDirectory}) { my $sub = $$newInfo{SubDirectory}; $subdirInfo{FixBase} = 1 if $$sub{FixBase}; $subdirInfo{FixOffsets} = $$sub{FixOffsets}; $subdirInfo{EntryBased} = $$sub{EntryBased}; $subdirInfo{NoFixBase} = 1 if defined $$sub{Base}; $subdirInfo{AutoFix} = $$sub{AutoFix}; } # get the proper tag table for these maker notes if ($oldInfo and $$oldInfo{SubDirectory}) { $subTable = $$oldInfo{SubDirectory}{TagTable}; $subTable and $subTable = Image::ExifTool::GetTagTable($subTable); $writeProc = $$oldInfo{SubDirectory}{WriteProc}; $notIFD = $$oldInfo{NotIFD}; } else { $et->Warn('Internal problem getting maker notes tag table'); } $writeProc or $writeProc = $$subTable{WRITE_PROC} if $subTable; $subTable or $subTable = $tagTablePtr; if ($writeProc and $writeProc eq \&Image::ExifTool::MakerNotes::WriteUnknownOrPreview and $oldValue =~ /^\xff\xd8\xff/) { $loc = 0; } elsif (not $notIFD) { # look for IFD-style maker notes $loc = Image::ExifTool::MakerNotes::LocateIFD($et,\%subdirInfo); } if (defined $loc) { # we need fixup data for this subdirectory $subdirInfo{Fixup} = new Image::ExifTool::Fixup; # rewrite maker notes my $changed = $$et{CHANGED}; $subdir = $et->WriteDirectory(\%subdirInfo, $subTable, $writeProc); if ($changed == $$et{CHANGED} and $subdirInfo{Fixup}->IsEmpty()) { # return original data if nothing changed and no fixups undef $subdir; } } elsif ($$subTable{PROCESS_PROC} and $$subTable{PROCESS_PROC} eq \&Image::ExifTool::ProcessBinaryData) { my $sub = $$oldInfo{SubDirectory}; if (defined $$sub{Start}) { #### eval Start ($valuePtr) my $start = eval $$sub{Start}; $loc = $start - $valuePtr; $subdirInfo{DirStart} = $start; $subdirInfo{DirLen} -= $loc; } else { $loc = 0; } # rewrite maker notes $subdir = $et->WriteDirectory(\%subdirInfo, $subTable); } elsif ($notIFD) { if ($writeProc) { $loc = 0; $subdir = $et->WriteDirectory(\%subdirInfo, $subTable); } } else { my $msg = 'Maker notes could not be parsed'; if ($$et{FILE_TYPE} eq 'JPEG') { $et->Warn($msg, 1); } else { $et->Error($msg, 1); } } if (defined $subdir) { next unless length $subdir; my $valLen = length($valBuff); # restore existing header and substitute the new # maker notes for the old value $newValue = substr($oldValue, 0, $loc) . $subdir; my $makerFixup = $subdirInfo{Fixup}; my $previewInfo = $$et{PREVIEW_INFO}; if ($subdirInfo{Relative}) { # apply a one-time fixup to $loc since offsets are relative $$makerFixup{Start} += $loc; # shift all offsets to be relative to new base my $baseShift = $valueDataPos + $valuePtr + $base - $subdirInfo{Base}; $$makerFixup{Shift} += $baseShift; $makerFixup->ApplyFixup(\$newValue); if ($previewInfo) { # remove all but PreviewImage fixup (since others shouldn't change) foreach (keys %{$$makerFixup{Pointers}}) { /_PreviewImage$/ or delete $$makerFixup{Pointers}{$_}; } # zero pointer so we can see how it gets shifted later $makerFixup->SetMarkerPointers(\$newValue, 'PreviewImage', 0); # set the pointer to the start of the EXIF information # add preview image fixup to list of value fixups $$makerFixup{Start} += $valLen; push @valFixups, $makerFixup; $$previewInfo{BaseShift} = $baseShift; $$previewInfo{Relative} = 1; } # don't shift anything if relative flag set to zero (Pentax patch) } elsif (not defined $subdirInfo{Relative}) { # shift offset base if shifted in the original image or if FixBase # was used, but be careful of automatic FixBase with negative shifts # since they may lead to negative (invalid) offsets (casio_edit_problem.jpg) my $baseShift = $base - $subdirInfo{Base}; if ($subdirInfo{AutoFix}) { $baseShift = 0; } elsif ($subdirInfo{FixBase} and $baseShift < 0 and # allow negative base shift if offsets are bigger (PentaxOptioWP.jpg) (not $subdirInfo{MinOffset} or $subdirInfo{MinOffset} + $baseShift < 0)) { my $fixBase = $et->Options('FixBase'); if (not defined $fixBase) { my $str = $et->Options('IgnoreMinorErrors') ? 'ignored' : 'fix or ignore?'; $et->Error("MakerNotes offsets may be incorrect ($str)", 1); } elsif ($fixBase eq '') { $et->Warn('Fixed incorrect MakerNotes offsets'); $baseShift = 0; } } $$makerFixup{Start} += $valLen + $loc; $$makerFixup{Shift} += $baseShift; # permanently fix makernote offset errors $$makerFixup{Shift} += $subdirInfo{FixedBy} || 0; push @valFixups, $makerFixup; if ($previewInfo and not $$previewInfo{NoBaseShift}) { $$previewInfo{BaseShift} = $baseShift; } } $newValuePt = \$newValue; # write new value } } SetByteOrder($saveOrder); # process existing subdirectory unless we are overwriting it entirely } elsif ($$newInfo{SubDirectory} and $isNew <= 0 and not $isOverwriting # don't edit directory if Writable is set to 0 and (not defined $$newInfo{Writable} or $$newInfo{Writable})) { my $subdir = $$newInfo{SubDirectory}; if ($$newInfo{SubIFD}) { # # rewrite existing sub IFD's # my $subTable = $tagTablePtr; if ($$subdir{TagTable}) { $subTable = Image::ExifTool::GetTagTable($$subdir{TagTable}); } # determine directory name for this IFD my $subdirName = $$newInfo{Groups}{1} || $$newInfo{Name}; # all makernotes directory names must be 'MakerNotes' $subdirName = 'MakerNotes' if $$subTable{GROUPS}{0} eq 'MakerNotes'; # must handle sub-IFD's specially since the values # are actually offsets to subdirectories unless ($readCount) { # can't have zero count return undef if $et->Error("$name entry $index has zero count", 2); next; } my $writeCount = 0; my $i; $newValue = ''; # reset value because we regenerate it below for ($i=0; $i<$readCount; ++$i) { my $off = $i * $formatSize[$readFormat]; my $val = ReadValue($valueDataPt, $valuePtr + $off, $readFormName, 1, $oldSize - $off); my $subdirStart = $val - $dataPos; my $subdirBase = $base; my $hdrLen; if (defined $$subdir{Start}) { #### eval Start ($val) my $newStart = eval $$subdir{Start}; unless (Image::ExifTool::IsInt($newStart)) { $et->Error("Bad subdirectory start for $$newInfo{Name}"); next; } $newStart -= $dataPos; $hdrLen = $newStart - $subdirStart; $subdirStart = $newStart; } if ($$subdir{Base}) { my $start = $subdirStart + $dataPos; #### eval Base ($start,$base) $subdirBase += eval $$subdir{Base}; } # add IFD number if more than one $subdirName =~ s/\d*$/$i/ if $i; my %subdirInfo = ( Base => $subdirBase, DataPt => $dataPt, DataPos => $dataPos - $subdirBase + $base, DataLen => $dataLen, DirStart => $subdirStart, DirName => $subdirName, Name => $$newInfo{Name}, TagInfo => $newInfo, Parent => $dirName, Fixup => new Image::ExifTool::Fixup, RAF => $raf, Subdir => $subdir, # set ImageData only for 1st level SubIFD's ImageData=> $imageDataFlag eq 'Main' ? 'SubIFD' : undef, ); # pass on header pointer only for certain sub IFD's $subdirInfo{HeaderPtr} = $$dirInfo{HeaderPtr} if $$newInfo{SubIFD} == 2; if ($$subdir{RelativeBase}) { # apply one-time fixup if offsets are relative (Sony IDC hack) delete $subdirInfo{Fixup}; delete $subdirInfo{ImageData}; } # is the subdirectory outside our current data? if ($subdirStart < 0 or $subdirStart + 2 > $dataLen) { if ($raf) { # reset SubDirectory buffer (we will load it later) my $buff = ''; $subdirInfo{DataPt} = \$buff; $subdirInfo{DataLen} = 0; } else { my @err = ("Can't read $subdirName data", $inMakerNotes); if ($$subTable{VARS} and $$subTable{VARS}{MINOR_ERRORS}) { $et->Warn($err[0] . '. Ignored.'); } elsif ($et->Error(@err)) { return undef; } next Entry; # don't write this directory } } my $subdirData = $et->WriteDirectory(\%subdirInfo, $subTable, $$subdir{WriteProc}); unless (defined $subdirData) { # WriteDirectory should have issued an error, but check just in case $et->Error("Error writing $subdirName") unless $$et{VALUE}{Error}; return undef; } # add back original header if necessary (eg. Ricoh GR) if ($hdrLen and $hdrLen > 0 and $subdirStart <= $dataLen) { $subdirData = substr($$dataPt, $subdirStart - $hdrLen, $hdrLen) . $subdirData; $subdirInfo{Fixup}{Start} += $hdrLen; } unless (length $subdirData) { next unless $inMakerNotes; # don't delete MakerNote Sub-IFD's, write empty IFD instead $subdirData = "\0" x 6; # reset SubIFD ImageData and Fixup just to be safe delete $subdirInfo{ImageData}; delete $subdirInfo{Fixup}; } # handle data blocks that we will transfer later if (ref $subdirInfo{ImageData}) { push @imageData, @{$subdirInfo{ImageData}}; $$origDirInfo{ImageData} = \@imageData; } # temporarily set value to subdirectory index # (will set to actual offset later when we know what it is) $newValue .= Set32u(0xfeedf00d); my ($offset, $where); if ($readCount > 1) { $offset = length($valBuff) + $i * 4; $where = 'valBuff'; } else { $offset = length($dirBuff) + 8; $where = 'dirBuff'; } # add to list of subdirectories we will append later push @subdirs, { DataPt => \$subdirData, Table => $subTable, Fixup => $subdirInfo{Fixup}, Offset => $offset, Where => $where, ImageData => $subdirInfo{ImageData}, }; ++$writeCount; # count number of subdirs written } next unless length $newValue; # must change location of subdir offset if we deleted # a directory and only one remains if ($writeCount < $readCount and $writeCount == 1) { $subdirs[-1]{Where} = 'dirBuff'; $subdirs[-1]{Offset} = length($dirBuff) + 8; } # set new format to int32u for IFD $newFormName = $$newInfo{FixFormat} || 'int32u'; $newFormat = $formatNumber{$newFormName}; $newValuePt = \$newValue; } elsif ((not defined $$subdir{Start} or $$subdir{Start} =~ /\$valuePtr/) and $$subdir{TagTable}) { # # rewrite other existing subdirectories ('$valuePtr' type only) # # set subdirectory Start and Base my $subdirStart = $valuePtr; if ($$subdir{Start}) { #### eval Start ($valuePtr) $subdirStart = eval $$subdir{Start}; # must adjust directory size if start changed $oldSize -= $subdirStart - $valuePtr; } my $subdirBase = $base; if ($$subdir{Base}) { my $start = $subdirStart + $valueDataPos; #### eval Base ($start,$base) $subdirBase += eval $$subdir{Base}; } my $subFixup = new Image::ExifTool::Fixup; my %subdirInfo = ( Base => $subdirBase, DataPt => $valueDataPt, DataPos => $valueDataPos - $subdirBase + $base, DataLen => $valueDataLen, DirStart => $subdirStart, DirName => $$subdir{DirName}, DirLen => $oldSize, Parent => $dirName, Fixup => $subFixup, RAF => $raf, TagInfo => $newInfo, ); unless ($oldSize) { # replace with dummy data if empty to prevent WriteDirectory # routines from accessing data they shouldn't my $tmp = ''; $subdirInfo{DataPt} = \$tmp; $subdirInfo{DataLen} = 0; $subdirInfo{DirStart} = 0; $subdirInfo{DataPos} += $subdirStart; } my $subTable = Image::ExifTool::GetTagTable($$subdir{TagTable}); my $oldOrder = GetByteOrder(); SetByteOrder($$subdir{ByteOrder}) if $$subdir{ByteOrder}; $newValue = $et->WriteDirectory(\%subdirInfo, $subTable, $$subdir{WriteProc}); SetByteOrder($oldOrder); if (defined $newValue) { my $hdrLen = $subdirStart - $valuePtr; if ($hdrLen) { $newValue = substr($$valueDataPt, $valuePtr, $hdrLen) . $newValue; $$subFixup{Start} += $hdrLen; } $newValuePt = \$newValue; } else { $newValuePt = \$oldValue; } unless (length $$newValuePt) { # don't delete a previously empty makernote directory next if $oldSize or not $inMakerNotes; } if ($$subFixup{Pointers} and $subdirInfo{Base} == $base) { $$subFixup{Start} += length $valBuff; push @valFixups, $subFixup; } else { # apply fixup in case we added a header ($hdrLen above) $subFixup->ApplyFixup(\$newValue); } } } elsif ($$newInfo{OffsetPair}) { # # keep track of offsets # my $dataTag = $$newInfo{DataTag} || ''; if ($dataTag eq 'CanonVRD') { # must decide now if we will write CanonVRD information my $hasVRD; if ($$et{NEW_VALUE}{$Image::ExifTool::Extra{CanonVRD}}) { # adding or deleting as a block $hasVRD = $et->GetNewValue('CanonVRD') ? 1 : 0; } elsif ($$et{DEL_GROUP}{CanonVRD} or $$et{DEL_GROUP}{Trailer}) { $hasVRD = 0; # deleting as a group } else { $hasVRD = ($$newValuePt ne "\0\0\0\0"); } if ($hasVRD) { # add a fixup, and set this offset later $dirFixup->AddFixup(length($dirBuff) + 8, $dataTag); } else { # there is (or will soon be) no VRD information, so set pointer to zero $newValue = "\0" x length($$newValuePt); $newValuePt = \$newValue; } } elsif ($dataTag eq 'OriginalDecisionData') { # handle Canon OriginalDecisionData (no associated length tag) # - I'm going out of my way here to preserve data which is # invalidated anyway by our edits my $odd; my $oddInfo = $Image::ExifTool::Composite{OriginalDecisionData}; if ($oddInfo and $$et{NEW_VALUE}{$oddInfo}) { $odd = $et->GetNewValue($dataTag); if ($verbose > 1) { print $out " - $dirName:$dataTag\n" if $$newValuePt ne "\0\0\0\0"; print $out " + $dirName:$dataTag\n" if $odd; } ++$$et{CHANGED}; } elsif ($$newValuePt ne "\0\0\0\0") { if (length($$newValuePt) == 4) { require Image::ExifTool::Canon; my $offset = Get32u($newValuePt,0); # absolute offset in JPEG images only $offset += $base unless $$et{FILE_TYPE} eq 'JPEG'; $odd = Image::ExifTool::Canon::ReadODD($et, $offset); $odd = $$odd if ref $odd; } else { $et->Error("Invalid $$newInfo{Name}",1); } } if ($odd) { my $newOffset = length($valBuff); # (ODD offset is absolute in JPEG, so add base offset!) $newOffset += $base if $$et{FILE_TYPE} eq 'JPEG'; $newValue = Set32u($newOffset); $dirFixup->AddFixup(length($dirBuff) + 8, $dataTag); $valBuff .= $odd; # add original decision data } else { $newValue = "\0\0\0\0"; } $newValuePt = \$newValue; } else { my $offsetInfo = $offsetInfo[$ifd]; # save original values (for updating TIFF_END later) my @vals; if ($isNew <= 0) { my $oldOrder = GetByteOrder(); # Minolta A200 stores these in the wrong byte order! SetByteOrder($$newInfo{ByteOrder}) if $$newInfo{ByteOrder}; @vals = ReadValue(\$oldValue, 0, $readFormName, $readCount, $oldSize); SetByteOrder($oldOrder); } # only support int32 pointers (for now) if ($formatSize[$newFormat] != 4 and $$newInfo{IsOffset}) { $isNew > 0 and warn("Internal error (Offset not int32)"), return undef; $newCount != $readCount and warn("Wrong count!"), return undef; # change to int32 $newFormName = 'int32u'; $newFormat = $formatNumber{$newFormName}; $newValue = WriteValue(join(' ',@vals), $newFormName, $newCount); unless (defined $newValue) { warn "Internal error writing offsets for $$newInfo{Name}\n"; return undef; } } $offsetInfo or $offsetInfo = $offsetInfo[$ifd] = { }; # save location of valuePtr in new directory # (notice we add 10 instead of 8 for valuePtr because # we will put a 2-byte count at start of directory later) my $ptr = $newStart + length($dirBuff) + 10; $newCount or $newCount = 1; # make sure count is set for offsetInfo # save value pointer and value count for each tag $$offsetInfo{$newID} = [$newInfo, $ptr, $newCount, \@vals, $newFormat]; } } elsif ($$newInfo{DataMember}) { # save any necessary data members (Make, Model, etc) my $formatStr = $newFormName; my $count = $newCount; # change to specified format if necessary if ($$newInfo{Format} and $$newInfo{Format} ne $formatStr) { $formatStr = $$newInfo{Format}; my $format = $formatNumber{$formatStr}; # adjust number of items for new format size $count = int(length($$newValuePt) / $formatSize[$format]) if $format; } my $val = ReadValue($newValuePt,0,$formatStr,$count,length($$newValuePt)); my $conv = $$newInfo{RawConv}; if ($conv) { # let the RawConv store the (possibly converted) data member if (ref $conv eq 'CODE') { &$conv($val, $et); } else { my ($self, $tag, $taginfo) = ($et, $$newInfo{Name}, $newInfo); #### eval RawConv ($self, $val, $tag, $tagInfo) eval $conv; } } else { $$et{$$newInfo{DataMember}} = $val; } } } # # write out the directory entry # my $newSize = length($$newValuePt); my $fsize = $formatSize[$newFormat]; my $offsetVal; $newCount = int(($newSize + $fsize - 1) / $fsize); # set proper count if ($newSize > 4) { # zero-pad to an even number of bytes (required by EXIF standard) # and make sure we are a multiple of the format size while ($newSize & 0x01 or $newSize < $newCount * $fsize) { $$newValuePt .= "\0"; ++$newSize; } my $entryBased; if ($$dirInfo{EntryBased} or ($newInfo and $$newInfo{EntryBased})) { $entryBased = 1; $offsetVal = Set32u(length($valBuff) - length($dirBuff)); } else { $offsetVal = Set32u(length $valBuff); } my ($dataTag, $putFirst); ($dataTag, $putFirst) = @$newInfo{'DataTag','PutFirst'} if $newInfo; if ($dataTag) { if ($dataTag eq 'PreviewImage' and ($$et{FILE_TYPE} eq 'JPEG' or $$et{GENERATE_PREVIEW_INFO})) { # hold onto the PreviewImage until we can determine if it fits $$et{PREVIEW_INFO} or $$et{PREVIEW_INFO} = { Data => $$newValuePt, Fixup => new Image::ExifTool::Fixup, }; $$et{PREVIEW_INFO}{ChangeBase} = 1 if $$newInfo{ChangeBase}; if ($$newInfo{IsOffset} and $$newInfo{IsOffset} eq '2') { $$et{PREVIEW_INFO}{NoBaseShift} = 1; } # use original preview size if we will attempt to load it later $newCount = $oldCount if $$newValuePt eq 'LOAD_PREVIEW'; $$newValuePt = ''; } elsif ($dataTag eq 'LeicaTrailer' and $$et{LeicaTrailer}) { $$newValuePt = ''; } } if ($putFirst and $$dirInfo{HeaderPtr}) { my $hdrPtr = $$dirInfo{HeaderPtr}; # place this value immediately after the TIFF header (eg. IIQ maker notes) $offsetVal = Set32u(length $$hdrPtr); $$hdrPtr .= $$newValuePt; } else { $valBuff .= $$newValuePt; # add value data to buffer # must save a fixup pointer for every pointer in the directory if ($entryBased) { $entryBasedFixup or $entryBasedFixup = new Image::ExifTool::Fixup; $entryBasedFixup->AddFixup(length($dirBuff) + 8, $dataTag); } else { $dirFixup->AddFixup(length($dirBuff) + 8, $dataTag); } } } else { $offsetVal = $$newValuePt; # save value in offset if 4 bytes or less # must pad value with zeros if less than 4 bytes $newSize < 4 and $offsetVal .= "\0" x (4 - $newSize); } # write the directory entry $dirBuff .= Set16u($newID) . Set16u($newFormat) . Set32u($newCount) . $offsetVal; # update flag to keep track of mandatory tags while (defined $allMandatory) { if (defined $$mandatory{$newID}) { # values must correspond to mandatory values my $form = $$newInfo{Format} || $newFormName; my $mandVal = WriteValue($$mandatory{$newID}, $form, $newCount); if (defined $mandVal and $mandVal eq $$newValuePt) { ++$allMandatory; # count mandatory tags last; } } undef $deleteAll; undef $allMandatory; } } if ($ignoreCount) { my $y = $ignoreCount > 1 ? 'ies' : 'y'; my $verb = $$dirInfo{FixBase} ? 'Ignored' : 'Removed'; $et->Warn("$verb $ignoreCount invalid entr$y from $name", 1); } if ($fixCount) { my $s = $fixCount > 1 ? 's' : ''; $et->Warn("Fixed invalid count$s for $fixCount $name tag$s", 1); } #.............................................................................. # write directory counts and nextIFD pointer and add value data to end of IFD # # determine now if there is or will be another IFD after this one my $nextIfdOffset; if ($dirEnd + 4 <= $dataLen) { $nextIfdOffset = Get32u($dataPt, $dirEnd); } else { $nextIfdOffset = 0; } my $isNextIFD = ($$dirInfo{Multi} and ($nextIfdOffset or # account for the case where we will create the next IFD # (IFD1 only, but not in TIFF-format images) ($dirName eq 'IFD0' and $$et{ADD_DIRS}{'IFD1'} and $$et{FILE_TYPE} ne 'TIFF'))); # calculate number of entries in new directory my $newEntries = length($dirBuff) / 12; # delete entire directory if we deleted a tag and only mandatory tags remain or we # attempted to create a directory with only mandatory tags and there is no nextIFD if ($allMandatory and not $isNextIFD and ($newEntries < $numEntries or $numEntries == 0)) { $newEntries = 0; $dirBuff = ''; $valBuff = ''; undef $dirFixup; # no fixups in this directory ++$deleteAll if defined $deleteAll; $verbose > 1 and print $out " - $allMandatory mandatory tag(s)\n"; $$et{CHANGED} -= $addMandatory; # didn't change these after all } if ($ifd and not $newEntries) { $verbose and print $out " Deleting IFD1\n"; last; # don't write IFD1 if empty } # apply one-time fixup for entry-based offsets if ($entryBasedFixup) { $$entryBasedFixup{Shift} = length($dirBuff) + 4; $entryBasedFixup->ApplyFixup(\$dirBuff); undef $entryBasedFixup; } # initialize next IFD pointer to zero my $nextIFD = Set32u(0); # some cameras use a different amount of padding after the makernote IFD if ($dirName eq 'MakerNotes' and $$dirInfo{Parent} =~ /^(ExifIFD|IFD0)$/) { my ($rel, $pad) = Image::ExifTool::MakerNotes::GetMakerNoteOffset($et); $nextIFD = "\0" x $pad if defined $pad and ($pad==0 or ($pad>4 and $pad<=32)); } # add directory entry count to start of IFD and next IFD pointer to end $newData .= Set16u($newEntries) . $dirBuff . $nextIFD; # get position of value data in newData my $valPos = length($newData); # go back now and set next IFD pointer if this isn't the first IFD if ($nextIfdPos) { # set offset to next IFD Set32u($newStart, \$newData, $nextIfdPos); $fixup->AddFixup($nextIfdPos,'NextIFD'); # add fixup for this offset in newData } # remember position of 'next IFD' pointer so we can set it next time around $nextIfdPos = length($nextIFD) ? $valPos - length($nextIFD) : undef; # add value data after IFD $newData .= $valBuff; # # add any subdirectories, adding fixup information # if (@subdirs) { my $subdir; foreach $subdir (@subdirs) { my $len = length($newData); # position of subdirectory in data my $subdirFixup = $$subdir{Fixup}; if ($subdirFixup) { $$subdirFixup{Start} += $len; $fixup->AddFixup($subdirFixup); } my $imageData = $$subdir{ImageData}; my $blockSize = 0; # must also update start position for ImageData fixups if (ref $imageData) { my $blockInfo; foreach $blockInfo (@$imageData) { my ($pos, $size, $pad, $entry, $subFix) = @$blockInfo; if ($subFix) { $$subFix{Start} += $len; # save expected image data offset for calculating shift later $$subFix{BlockLen} = length(${$$subdir{DataPt}}) + $blockSize; } $blockSize += $size + $pad; } } $newData .= ${$$subdir{DataPt}}; # add subdirectory to our data undef ${$$subdir{DataPt}}; # free memory now # set the pointer my $offset = $$subdir{Offset}; # if offset is in valBuff, it was added to the end of dirBuff # (plus 4 bytes for nextIFD pointer) $offset += length($dirBuff) + 4 if $$subdir{Where} eq 'valBuff'; $offset += $newStart + 2; # get offset in newData # check to be sure we got the right offset unless (Get32u(\$newData, $offset) == 0xfeedf00d) { $et->Error("Internal error while rewriting $name"); return undef; } # set the offset to the subdirectory data Set32u($len, \$newData, $offset); $fixup->AddFixup($offset); # add fixup for this offset in newData } } # add fixup for all offsets in directory according to value data position # (which is at the end of this directory) if ($dirFixup) { $$dirFixup{Start} = $newStart + 2; $$dirFixup{Shift} = $valPos - $$dirFixup{Start}; $fixup->AddFixup($dirFixup); } # add valueData fixups, adjusting for position of value data my $valFixup; foreach $valFixup (@valFixups) { $$valFixup{Start} += $valPos; $fixup->AddFixup($valFixup); } # stop if no next IFD pointer last unless $isNextIFD; # stop unless scanning for multiple IFD's if ($nextIfdOffset) { # continue with next IFD $dirStart = $nextIfdOffset - $dataPos; } else { # create IFD1 if necessary $verbose and print $out " Creating IFD1\n"; my $ifd1 = "\0" x 2; # empty IFD1 data (zero entry count) $dataPt = \$ifd1; $dirStart = 0; $dirLen = $dataLen = 2; } # increment IFD name my $ifdNum = $dirName =~ s/(\d+)$// ? $1 : 0; $dirName .= $ifdNum + 1; $name =~ s/\d+$//; $name .= $ifdNum + 1; $$et{DIR_NAME} = $$et{PATH}[-1] = $dirName; next unless $nextIfdOffset; # guard against writing the same directory twice my $addr = $nextIfdOffset + $base; if ($$et{PROCESSED}{$addr}) { $et->Error("$name pointer references previous $$et{PROCESSED}{$addr} directory", 1); last; } $$et{PROCESSED}{$addr} = $name; if ($dirName eq 'SubIFD1' and not ValidateIFD($dirInfo, $dirStart)) { if ($$et{TIFF_TYPE} eq 'TIFF') { $et->Error('Ignored bad IFD linked from SubIFD', 1); } elsif ($verbose) { $et->Warn('Ignored bad IFD linked from SubIFD'); } last; # don't write bad IFD } if ($$et{DEL_GROUP}{$dirName}) { $verbose and print $out " Deleting $dirName\n"; $raf and $et->Error("Deleting $dirName also deletes subsequent" . " IFD's and possibly image data", 1); ++$$et{CHANGED}; if ($$et{DEL_GROUP}{$dirName} == 2 and $$et{ADD_DIRS}{$dirName}) { my $emptyIFD = "\0" x 2; # start with empty IFD $dataPt = \$emptyIFD; $dirStart = 0; $dirLen = $dataLen = 2; } else { last; # don't write this IFD (or any subsequent IFD) } } else { $verbose and print $out " Rewriting $name\n"; } } #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ # do our fixups now so we can more easily calculate offsets below $fixup->ApplyFixup(\$newData); # # determine total block size for deferred data # my $numBlocks = scalar @imageData; # save this so we scan only existing blocks later my $blockSize = 0; # total size of blocks to copy later my $blockInfo; foreach $blockInfo (@imageData) { my ($pos, $size, $pad) = @$blockInfo; $blockSize += $size + $pad; } # # copy over image data for IFD's, starting with the last IFD first # if (@offsetInfo) { my $ttwLen; # length of MRW TTW segment my @writeLater; # write image data last for ($ifd=$#offsetInfo; $ifd>=-1; --$ifd) { # build list of offsets to process my @offsetList; if ($ifd >= 0) { my $offsetInfo = $offsetInfo[$ifd] or next; # patch Panasonic RAW/RW2 StripOffsets/StripByteCounts if necessary my $stripOffsets = $$offsetInfo{0x111}; if ($stripOffsets and $$stripOffsets[0]{PanasonicHack}) { require Image::ExifTool::PanasonicRaw; my $err = Image::ExifTool::PanasonicRaw::PatchRawDataOffset($offsetInfo, $raf, $ifd); $err and $et->Error($err); } my $tagID; # loop through all tags in reverse order so we save thumbnail # data before main image data if both exist in the same IFD foreach $tagID (reverse sort keys %$offsetInfo) { my $tagInfo = $$offsetInfo{$tagID}[0]; next unless $$tagInfo{IsOffset}; # handle byte counts with offsets my $sizeInfo = $$offsetInfo{$$tagInfo{OffsetPair}}; $sizeInfo or $et->Error("No size tag for $dirName:$$tagInfo{Name}"), next; my $dataTag = $$tagInfo{DataTag}; # write TIFF image data (strips or tiles) later if requested if ($raf and defined $$origDirInfo{ImageData} and ($tagID == 0x111 or $tagID == 0x144 or # also defer writing of other big data such as JpgFromRaw in NEF ($$sizeInfo[3][0] and # (calculate approximate combined size of all blocks) $$sizeInfo[3][0] * scalar(@{$$sizeInfo[3]}) > 1000000)) and # but don't defer writing if replacing with new value (not defined $dataTag or not defined $offsetData{$dataTag})) { push @writeLater, [ $$offsetInfo{$tagID}, $sizeInfo ]; } else { push @offsetList, [ $$offsetInfo{$tagID}, $sizeInfo ]; } } } else { last unless @writeLater; @offsetList = @writeLater; } my $offsetPair; foreach $offsetPair (@offsetList) { my ($tagInfo, $offsets, $count, $oldOffset) = @{$$offsetPair[0]}; my ($cntInfo, $byteCounts, $count2, $oldSize, $format) = @{$$offsetPair[1]}; # must be the same number of offset and byte count values unless ($count == $count2) { $et->Error("Offsets/ByteCounts disagree on count for $$tagInfo{Name}"); return undef; } my $formatStr = $formatName[$format]; # follow pointer to value data if necessary $count > 1 and $offsets = Get32u(\$newData, $offsets); my $n = $count * $formatSize[$format]; $n > 4 and $byteCounts = Get32u(\$newData, $byteCounts); if ($byteCounts < 0 or $byteCounts + $n > length($newData)) { $et->Error("Error reading $$tagInfo{Name} byte counts"); return undef; } # get offset base and data pos (abnormal for some preview images) my ($dbase, $dpos, $wrongBase, $subIfdDataFixup); if ($$tagInfo{IsOffset} eq '2') { $dbase = $firstBase; $dpos = $dataPos + $base - $firstBase; } else { $dbase = $base; $dpos = $dataPos; } # use different base if necessary for some offsets (Minolta A200) if ($$tagInfo{WrongBase}) { my $self = $et; #### eval WrongBase ($self) $wrongBase = eval $$tagInfo{WrongBase} || 0; $dbase += $wrongBase; $dpos -= $wrongBase; } else { $wrongBase = 0; } my $oldOrder = GetByteOrder(); my $dataTag = $$tagInfo{DataTag}; # use different byte order for values of this offset pair if required (Minolta A200) SetByteOrder($$tagInfo{ByteOrder}) if $$tagInfo{ByteOrder}; # transfer the data referenced by all offsets of this tag for ($n=0; $n<$count; ++$n) { my ($oldEnd, $size); if (@$oldOffset and @$oldSize) { # calculate end offset of this block $oldEnd = $$oldOffset[$n] + $$oldSize[$n]; # update TIFF_END as if we read this data from file UpdateTiffEnd($et, $oldEnd + $dbase); } my $offsetPos = $offsets + $n * 4; my $byteCountPos = $byteCounts + $n * $formatSize[$format]; if ($$tagInfo{PanasonicHack}) { # use actual raw data length (may be different than StripByteCounts!) $size = $$oldSize[$n]; } else { # use size of new data $size = ReadValue(\$newData, $byteCountPos, $formatStr, 1, 4); } my $offset = $$oldOffset[$n]; if (defined $offset) { $offset -= $dpos; } elsif ($size != 0xfeedfeed) { $et->Error('Internal error (no offset)'); return undef; } my $newOffset = length($newData) - $wrongBase; my $buff; # look for 'feed' code to use our new data if ($size == 0xfeedfeed) { unless (defined $dataTag) { $et->Error("No DataTag defined for $$tagInfo{Name}"); return undef; } unless (defined $offsetData{$dataTag}) { $et->Error("Internal error (no $dataTag)"); return undef; } if ($count > 1) { $et->Error("Can't modify $$tagInfo{Name} with count $count"); return undef; } $buff = $offsetData{$dataTag}; if ($formatSize[$format] != 4) { $et->Error("$$cntInfo{Name} is not int32"); return undef; } # set the data size $size = length($buff); Set32u($size, \$newData, $byteCountPos); } elsif ($ifd < 0) { # pad if necessary (but don't pad contiguous image blocks) my $pad = 0; ++$pad if $size & 0x01 and ($n+1 >= $count or not $oldEnd or $oldEnd != $$oldOffset[$n+1]); # preserve original image padding if specified if ($$origDirInfo{PreserveImagePadding} and $n+1 < $count and $oldEnd and $$oldOffset[$n+1] > $oldEnd) { $pad = $$oldOffset[$n+1] - $oldEnd; } # copy data later push @imageData, [$offset+$dbase+$dpos, $size, $pad]; $newOffset += $blockSize; # data comes after other deferred data # create fixup for SubIFD ImageData if ($imageDataFlag eq 'SubIFD' and not $subIfdDataFixup) { $subIfdDataFixup = new Image::ExifTool::Fixup; $imageData[-1][4] = $subIfdDataFixup; } $size += $pad; # account for pad byte if necessary # return ImageData list $$origDirInfo{ImageData} = \@imageData; } elsif ($offset >= 0 and $offset+$size <= $dataLen) { # take data from old dir data buffer $buff = substr($$dataPt, $offset, $size); } elsif ($$et{TIFF_TYPE} eq 'MRW') { # TTW segment must be an even 4 bytes long, so pad now if necessary my $n = length $newData; $buff = ($n & 0x03) ? "\0" x (4 - ($n & 0x03)) : ''; $size = length($buff); # data exists after MRW TTW segment $ttwLen = length($newData) + $size unless defined $ttwLen; $newOffset = $offset + $dpos + $ttwLen - $dataLen; } elsif ($raf and $raf->Seek($offset+$dbase+$dpos,0) and $raf->Read($buff,$size) == $size) { # (data was read OK) # patch incorrect ThumbnailOffset in Sony A100 1.00 ARW images if ($$et{TIFF_TYPE} eq 'ARW' and $$tagInfo{Name} eq 'ThumbnailOffset' and $$et{Model} eq 'DSLR-A100' and $buff !~ /^\xff\xd8\xff/) { my $pos = $offset + $dbase + $dpos; my $try; if ($pos < 0x10000 and $raf->Seek($pos+0x10000,0) and $raf->Read($try,$size) == $size and $try =~ /^\xff\xd8\xff/) { $buff = $try; $et->Warn('Adjusted incorrect A100 ThumbnailOffset', 1); } else { $et->Error('Invalid ThumbnailImage'); } } } elsif ($$tagInfo{Name} eq 'ThumbnailOffset' and $offset>=0 and $offset<$dataLen) { # Grrr. The Canon 350D writes the thumbnail with an incorrect byte count my $diff = $offset + $size - $dataLen; $et->Warn("ThumbnailImage runs outside EXIF data by $diff bytes (truncated)",1); # set the size to the available data $size -= $diff; unless (WriteValue($size, $formatStr, 1, \$newData, $byteCountPos)) { warn 'Internal error writing thumbnail size'; } # get the truncated image $buff = substr($$dataPt, $offset, $size); } elsif ($$tagInfo{Name} eq 'PreviewImageStart' and $$et{FILE_TYPE} eq 'JPEG') { # try to load the preview image using the specified offset undef $buff; my $r = $$et{RAF}; if ($r and not $raf) { my $tell = $r->Tell(); # read and validate undef $buff unless $r->Seek($offset+$base+$dataPos,0) and $r->Read($buff,$size) == $size and $buff =~ /^.\xd8\xff[\xc4\xdb\xe0-\xef]/s; $r->Seek($tell, 0) or $et->Error('Seek error'), return undef; } # set flag if we must load PreviewImage $buff = 'LOAD_PREVIEW' unless defined $buff; } else { my $dataName = $dataTag || $$tagInfo{Name}; return undef if $et->Error("Error reading $dataName data in $name", $inMakerNotes); $buff = ''; } if ($$tagInfo{Name} eq 'PreviewImageStart') { if ($$et{FILE_TYPE} eq 'JPEG' and not $$tagInfo{MakerPreview}) { # hold onto the PreviewImage until we can determine if it fits $$et{PREVIEW_INFO} or $$et{PREVIEW_INFO} = { Data => $buff, Fixup => new Image::ExifTool::Fixup, }; if ($$tagInfo{IsOffset} and $$tagInfo{IsOffset} eq '2') { $$et{PREVIEW_INFO}{NoBaseShift} = 1; } if ($offset >= 0 and $offset+$size <= $dataLen) { # set flag indicating this preview wasn't in a trailer $$et{PREVIEW_INFO}{WasContained} = 1; } $buff = ''; } elsif ($$et{TIFF_TYPE} eq 'ARW' and $$et{Model} eq 'DSLR-A100') { # the A100 double-references the same preview, so ignore the # second one (the offset and size will be patched later) next if $$et{A100PreviewLength}; $$et{A100PreviewLength} = length $buff if defined $buff; } } # update offset accordingly and add to end of new data Set32u($newOffset, \$newData, $offsetPos); # add a pointer to fix up this offset value (marked with DataTag name) $fixup->AddFixup($offsetPos, $dataTag); # also add to subIfdDataFixup if necessary $subIfdDataFixup->AddFixup($offsetPos, $dataTag) if $subIfdDataFixup; # must also (sometimes) update StripOffsets in Panasonic RW2 images my $otherPos = $$offsetPair[0][5]; if ($otherPos and $$tagInfo{PanasonicHack}) { Set32u($newOffset, \$newData, $otherPos); $fixup->AddFixup($otherPos, $dataTag); } if ($ifd >= 0) { # buff length must be even (Note: may have changed since $size was set) $buff .= "\0" if length($buff) & 0x01; $newData .= $buff; # add this strip to the data } else { $blockSize += $size; # keep track of total size } } SetByteOrder($oldOrder); } } # verify that nothing else got written after determining TTW length if (defined $ttwLen and $ttwLen != length($newData)) { $et->Error('Internal error writing MRW TTW'); } } # # set offsets and generate fixups for tag values which were too large for memory # $blockSize = 0; foreach $blockInfo (@imageData) { my ($pos, $size, $pad, $entry, $subFix) = @$blockInfo; if (defined $entry) { my $format = Get16u(\$newData, $entry + 2); if ($format < 1 or $format > 13) { $et->Error('Internal error copying huge value'); last; } else { # set count and offset in directory entry Set32u($size / $formatSize[$format], \$newData, $entry + 4); Set32u(length($newData)+$blockSize, \$newData, $entry + 8); $fixup->AddFixup($entry + 8); # create special fixup for SubIFD data if ($imageDataFlag eq 'SubIFD') { my $subIfdDataFixup = new Image::ExifTool::Fixup; $subIfdDataFixup->AddFixup($entry + 8); # save fixup in imageData list $$blockInfo[4] = $subIfdDataFixup; } # must reset entry pointer so we don't use it again in a parent IFD! $$blockInfo[3] = undef; } } # apply additional shift required for contained SubIFD image data offsets if ($subFix and defined $$subFix{BlockLen} and $numBlocks > 0) { # our offset expects the data at the end of the SubIFD block (BlockLen + Start), # but it will actually be at length($newData) + $blockSize. So adjust # accordingly (and subtract an extra Start because this shift is applied later) $$subFix{Shift} += length($newData) - $$subFix{BlockLen} - 2 * $$subFix{Start} + $blockSize; $subFix->ApplyFixup(\$newData); } $blockSize += $size + $pad; --$numBlocks; } # # apply final shift to new data position if this is the top level IFD # unless ($$dirInfo{Fixup}) { my $hdrPtr = $$dirInfo{HeaderPtr}; my $newDataPos = $hdrPtr ? length $$hdrPtr : $$dirInfo{NewDataPos} || 0; # adjust CanonVRD offset to point to end of regular TIFF if necessary # (NOTE: This will be incorrect if multiple trailers exist, # but it is unlikely that it could ever be correct in this case anyway. # Also, this doesn't work for JPEG images (but CanonDPP doesn't set # this when editing JPEG images anyway)) $fixup->SetMarkerPointers(\$newData, 'CanonVRD', length($newData) + $blockSize); if ($newDataPos) { $$fixup{Shift} += $newDataPos; $fixup->ApplyFixup(\$newData); } # save fixup for adjusting Leica trailer offset if necessary $$et{LeicaTrailer}{Fixup}->AddFixup($fixup) if $$et{LeicaTrailer}; # save fixup for PreviewImage in JPEG file if necessary my $previewInfo = $$et{PREVIEW_INFO}; if ($previewInfo) { my $pt = \$$previewInfo{Data}; # image data or 'LOAD_PREVIEW' flag # now that we know the size of the EXIF data, first test to see if our new image fits # inside the EXIF segment (remember about the TIFF and EXIF headers: 8+6 bytes) if (($$pt ne 'LOAD_PREVIEW' and length($$pt) + length($newData) + 14 <= 0xfffd and not $$previewInfo{IsTrailer}) or $$previewInfo{IsShort}) # must fit in this segment if using short pointers { # It fits! (or must exist in EXIF segment), so fixup the # PreviewImage pointers and stuff the preview image in here my $newPos = length($newData) + $newDataPos; $newPos += ($$previewInfo{BaseShift} || 0); if ($$previewInfo{Relative}) { # calculate our base by looking at how far the pointer got shifted $newPos -= ($fixup->GetMarkerPointers(\$newData, 'PreviewImage') || 0); } $fixup->SetMarkerPointers(\$newData, 'PreviewImage', $newPos); $newData .= $$pt; # set flag to delete old preview unless it was contained in the EXIF $$et{DEL_PREVIEW} = 1 unless $$et{PREVIEW_INFO}{WasContained}; delete $$et{PREVIEW_INFO}; # done with our preview data } else { # Doesn't fit, or we still don't know, so save fixup information # and put the preview at the end of the file $$previewInfo{Fixup} or $$previewInfo{Fixup} = new Image::ExifTool::Fixup; $$previewInfo{Fixup}->AddFixup($fixup); } } elsif (defined $newData and $deleteAll) { $newData = ''; # delete both IFD0 and IFD1 since only mandatory tags remain } elsif ($$et{A100PreviewLength}) { # save preview image start for patching A100 quirks later $$et{A100PreviewStart} = $fixup->GetMarkerPointers(\$newData, 'PreviewImage'); } # save location of last IFD for use in Canon RAW header if ($newDataPos == 16) { my @ifdPos = $fixup->GetMarkerPointers(\$newData,'NextIFD'); $$origDirInfo{LastIFD} = pop @ifdPos; } # recrypt SR2 SubIFD data if necessary my $key = $$et{SR2SubIFDKey}; if ($key) { my $start = $fixup->GetMarkerPointers(\$newData, 'SR2SubIFDOffset'); my $len = $$et{SR2SubIFDLength}; # (must subtract 8 for size of TIFF header) if ($start and $start - 8 + $len <= length $newData) { require Image::ExifTool::Sony; Image::ExifTool::Sony::Decrypt(\$newData, $start - 8, $len, $key); } } } # return empty string if no entries in directory # (could be up to 10 bytes and still be empty) $newData = '' if defined $newData and length($newData) < 12; return $newData; # return our directory data } 1; # end __END__ =head1 NAME Image::ExifTool::WriteExif.pl - Write EXIF meta information =head1 SYNOPSIS This file is autoloaded by Image::ExifTool::Exif. =head1 DESCRIPTION This file contains routines to write EXIF metadata. =head1 AUTHOR Copyright 2003-2016, Phil Harvey (phil at owl.phy.queensu.ca) This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 SEE ALSO L, L =cut