Context Navigation

WriteExif.pl@ 34921

Last change on this file since 34921 was 34921, checked in by anupama, 3 years ago

Committing the improvements to EmbeddedMetaPlugin's processing of Keywords vs other metadata fields. Keywords were literally stored as arrays of words rather than phrases in PDFs (at least in Diego's sample PDF), whereas other meta fields like Subjects and Creators stored them as arrays of phrases. To get both to work, Kathy updated EXIF to a newer version, to retrieve the actual EXIF values stored in the PDF. And Kathy and Dr Bainbridge came up with a new option that I added called apply_join_before_split_to_metafields that's a regex which can list the metadata fields to apply the join_before_split to and whcih previously always got applied to all metadata fields. Now it's applied to any *Keywords metafields by default, as that's the metafield we have experience of that behaves differently to the others, as it stores by word instead of phrases. Tested on Diego's sample PDF. Diego has double-checked it to works on his sample PDF too, setting the split char to ; and turning on the join_before_split and leaving apply_join_before_split_to_metafields at its default of .*Keywords. File changes are strings.properties for the tooltip, the plugin introducing the option and working with it and Kathy's EXIF updates affecting cpan/File and cpan/Image.

File size: 130.6 KB

Line
1	#------------------------------------------------------------------------------
2	# File: WriteExif.pl
3	#
4	# Description: Write EXIF meta information
5	#
6	# Revisions: 12/13/2004 - P. Harvey Created
7	#------------------------------------------------------------------------------
8
9	package Image::ExifTool::Exif;
10
11	use strict;
12	use vars qw($VERSION $AUTOLOAD @formatSize @formatName %formatNumber
13	%compression %photometricInterpretation %orientation);
14
15	use Image::ExifTool::Fixup;
16
17	# some information may be stored in different IFD's with the same meaning.
18	# Use this lookup to decide when we should delete information that is stored
19	# in another IFD when we write it to the preferred IFD.
20	my %crossDelete = (
21	ExifIFD => 'IFD0',
22	IFD0 => 'ExifIFD',
23	);
24
25	# mandatory tag default values
26	my %mandatory = (
27	IFD0 => {
28	0x011a => 72, # XResolution
29	0x011b => 72, # YResolution
30	0x0128 => 2, # ResolutionUnit (inches)
31	0x0213 => 1, # YCbCrPositioning (centered)
32	# 0x8769 => ????, # ExifOffset
33	},
34	IFD1 => {
35	0x0103 => 6, # Compression (JPEG)
36	0x011a => 72, # XResolution
37	0x011b => 72, # YResolution
38	0x0128 => 2, # ResolutionUnit (inches)
39	},
40	ExifIFD => {
41	0x9000 => '0232', # ExifVersion
42	0x9101 => "1 2 3 0",# ComponentsConfiguration
43	0xa000 => '0100', # FlashpixVersion
44	0xa001 => 0xffff, # ColorSpace (uncalibrated)
45	# 0xa002 => ????, # ExifImageWidth
46	# 0xa003 => ????, # ExifImageHeight
47	},
48	GPS => {
49	0x0000 => '2 3 0 0',# GPSVersionID
50	},
51	InteropIFD => {
52	0x0002 => '0100', # InteropVersion
53	},
54	);
55
56	#------------------------------------------------------------------------------
57	# Inverse print conversion for LensInfo
58	# Inputs: 0) lens info string
59	# Returns: PrintConvInv of string
60	sub ConvertLensInfo($)
61	{
62	my $val = shift;
63	my @a = GetLensInfo($val, 1); # (allow unknown "?" values)
64	return @a ? join(' ', @a) : $val;
65	}
66
67	#------------------------------------------------------------------------------
68	# Get binary CFA Pattern from a text string
69	# Inputs: Print-converted CFA pattern (eg. '[Blue,Green][Green,Red]')
70	# Returns: CFA pattern as a string of numbers
71	sub GetCFAPattern($)
72	{
73	my $val = shift;
74	my @rows = split /\]\s*\[/, $val;
75	@rows or warn("Rows not properly bracketed by '[]'\n"), return undef;
76	my @cols = split /,/, $rows[0];
77	@cols or warn("Colors not separated by ','\n"), return undef;
78	my $ny = @cols;
79	my @a = (scalar(@rows), scalar(@cols));
80	my %cfaLookup = (red=>0, green=>1, blue=>2, cyan=>3, magenta=>4, yellow=>5, white=>6);
81	my $row;
82	foreach $row (@rows) {
83	@cols = split /,/, $row;
84	@cols == $ny or warn("Inconsistent number of colors in each row\n"), return undef;
85	foreach (@cols) {
86	tr/ \]\[//d; # remove remaining brackets and any spaces
87	my $c = $cfaLookup{lc($_)};
88	defined $c or warn("Unknown color '${_}'\n"), return undef;
89	push @a, $c;
90	}
91	}
92	return "@a";
93	}
94
95	#------------------------------------------------------------------------------
96	# validate raw values for writing
97	# Inputs: 0) ExifTool ref, 1) tagInfo hash ref, 2) raw value ref
98	# Returns: error string or undef (and possibly changes value) on success
99	sub CheckExif($$$)
100	{
101	my ($et, $tagInfo, $valPtr) = @_;
102	my $format = $$tagInfo{Format} \|\| $$tagInfo{Writable} \|\| $$tagInfo{Table}{WRITABLE};
103	if (not $format or $format eq '1') {
104	if ($$tagInfo{Groups}{0} eq 'MakerNotes') {
105	return undef; # OK to have no format for makernotes
106	} else {
107	return 'No writable format';
108	}
109	}
110	return Image::ExifTool::CheckValue($valPtr, $format, $$tagInfo{Count});
111	}
112
113	#------------------------------------------------------------------------------
114	# encode exif ASCII/Unicode text from UTF8 or Latin
115	# Inputs: 0) ExifTool ref, 1) text string
116	# Returns: encoded string
117	# Note: MUST be called Raw conversion time so the EXIF byte order is known!
118	sub EncodeExifText($$)
119	{
120	my ($et, $val) = @_;
121	# does the string contain special characters?
122	if ($val =~ /[\x80-\xff]/) {
123	my $order = $et->GetNewValue('ExifUnicodeByteOrder');
124	return "UNICODE\0" . $et->Encode($val,'UTF16',$order);
125	} else {
126	return "ASCII\0\0\0$val";
127	}
128	}
129
130	#------------------------------------------------------------------------------
131	# rebuild maker notes to properly contain all value data
132	# (some manufacturers put value data outside maker notes!!)
133	# Inputs: 0) ExifTool object ref, 1) dirInfo ref, 2) tag table ref
134	# Returns: new maker note data (and creates MAKER_NOTE_FIXUP), or undef on error
135	sub RebuildMakerNotes($$$)
136	{
137	my ($et, $dirInfo, $tagTablePtr) = @_;
138	my $dirStart = $$dirInfo{DirStart};
139	my $dirLen = $$dirInfo{DirLen};
140	my $dataPt = $$dirInfo{DataPt};
141	my $dataPos = $$dirInfo{DataPos} \|\| 0;
142	my $rtnValue;
143	my %subdirInfo = %$dirInfo;
144
145	delete $$et{MAKER_NOTE_FIXUP};
146
147	# don't need to rebuild text, BinaryData or PreviewImage maker notes
148	my $tagInfo = $$dirInfo{TagInfo};
149	my $subdir = $$tagInfo{SubDirectory};
150	my $proc = $$subdir{ProcessProc} \|\| $$tagTablePtr{PROCESS_PROC} \|\| \&ProcessExif;
151	if (($proc ne \&ProcessExif and $$tagInfo{Name} =~ /Text/) or
152	$proc eq \&Image::ExifTool::ProcessBinaryData or
153	($$tagInfo{PossiblePreview} and $dirLen > 6 and
154	substr($$dataPt, $dirStart, 3) eq "\xff\xd8\xff"))
155	{
156	return substr($$dataPt, $dirStart, $dirLen);
157	}
158	my $saveOrder = GetByteOrder();
159	my $loc = Image::ExifTool::MakerNotes::LocateIFD($et,\%subdirInfo);
160	if (defined $loc) {
161	my $makerFixup = $subdirInfo{Fixup} = new Image::ExifTool::Fixup;
162	# create new exiftool object to rewrite the directory without changing it
163	my $newTool = new Image::ExifTool;
164	$newTool->Options(
165	IgnoreMinorErrors => $$et{OPTIONS}{IgnoreMinorErrors},
166	FixBase => $$et{OPTIONS}{FixBase},
167	);
168	$newTool->Init(); # must do this before calling WriteDirectory()!
169	# don't copy over preview image
170	$newTool->SetNewValue(PreviewImage => '');
171	# copy all transient members over in case they are used for writing
172	# (Make, Model, etc)
173	foreach (grep /[a-z]/, keys %$et) {
174	$$newTool{$_} = $$et{$_};
175	}
176	# fix base offsets if specified
177	$newTool->Options(FixBase => $et->Options('FixBase'));
178	# set GENERATE_PREVIEW_INFO flag so PREVIEW_INFO will be generated
179	$$newTool{GENERATE_PREVIEW_INFO} = 1;
180	# drop any large tags
181	$$newTool{DropTags} = 1;
182	# initialize other necessary data members
183	$$newTool{FILE_TYPE} = $$et{FILE_TYPE};
184	$$newTool{TIFF_TYPE} = $$et{TIFF_TYPE};
185	# rewrite maker notes
186	$rtnValue = $newTool->WriteDirectory(\%subdirInfo, $tagTablePtr);
187	if (defined $rtnValue and length $rtnValue) {
188	# add the dummy/empty preview image if necessary
189	if ($$newTool{PREVIEW_INFO}) {
190	$makerFixup->SetMarkerPointers(\$rtnValue, 'PreviewImage', length($rtnValue));
191	$rtnValue .= $$newTool{PREVIEW_INFO}{Data};
192	delete $$newTool{PREVIEW_INFO};
193	}
194	# add makernote header
195	if ($loc) {
196	my $hdr = substr($$dataPt, $dirStart, $loc);
197	# special case: convert Pentax/Samsung DNG maker notes to JPEG style
198	# (in JPEG, Pentax makernotes are absolute and start with "AOC\0" for some
199	# models, but in DNG images they are stored in tag 0xc634 of IFD0 and
200	# start with either "PENTAX \0" or "SAMSUNG\0")
201	if ($$dirInfo{Parent} eq 'IFD0' and $hdr =~ /^(PENTAX \|SAMSUNG)\0/) {
202	# convert to JPEG-style AOC maker notes if used by this model
203	# (Note: this expression also appears in Exif.pm)
204	if ($$et{Model} =~ /\b(K(-[57mrx]\|(10\|20\|100\|110\|200)D\|2000)\|GX(10\|20))\b/) {
205	$hdr =~ s/^(PENTAX \|SAMSUNG)\0/AOC\0/;
206	# save fixup because AOC maker notes have absolute offsets
207	$$et{MAKER_NOTE_FIXUP} = $makerFixup;
208	}
209	}
210	$rtnValue = $hdr . $rtnValue;
211	# adjust fixup for shift in start position
212	$$makerFixup{Start} += length $hdr;
213	}
214	# shift offsets according to original position of maker notes,
215	# and relative to the makernotes Base
216	$$makerFixup{Shift} += $dataPos + $dirStart +
217	$$dirInfo{Base} - $subdirInfo{Base};
218	# repair incorrect offsets if offsets were fixed
219	$$makerFixup{Shift} += $subdirInfo{FixedBy} \|\| 0;
220	# fix up pointers to the specified offset
221	$makerFixup->ApplyFixup(\$rtnValue);
222	# save fixup information unless offsets were relative
223	unless ($subdirInfo{Relative}) {
224	# set shift so offsets are all relative to start of maker notes
225	$$makerFixup{Shift} -= $dataPos + $dirStart;
226	$$et{MAKER_NOTE_FIXUP} = $makerFixup; # save fixup for later
227	}
228	}
229	}
230	SetByteOrder($saveOrder);
231
232	return $rtnValue;
233	}
234
235	#------------------------------------------------------------------------------
236	# Sort IFD directory entries
237	# Inputs: 0) data reference, 1) directory start, 2) number of entries,
238	# 3) flag to treat 0 as a valid tag ID (as opposed to an empty IFD entry)
239	sub SortIFD($$$;$)
240	{
241	my ($dataPt, $dirStart, $numEntries, $allowZero) = @_;
242	my ($index, %entries);
243	# split the directory into separate entries
244	for ($index=0; $index<$numEntries; ++$index) {
245	my $entry = $dirStart + 2 + 12 * $index;
246	my $tagID = Get16u($dataPt, $entry);
247	my $entryData = substr($$dataPt, $entry, 12);
248	# silly software can pad directories with zero entries -- put these at the end
249	$tagID = 0x10000 unless $tagID or $index == 0 or $allowZero;
250	# add new entry (allow for duplicate tag ID's, which shouldn't normally happen)
251	if ($entries{$tagID}) {
252	$entries{$tagID} .= $entryData;
253	} else {
254	$entries{$tagID} = $entryData;
255	}
256	}
257	# sort the directory entries
258	my @sortedTags = sort { $a <=> $b } keys %entries;
259	# generate the sorted IFD
260	my $newDir = '';
261	foreach (@sortedTags) {
262	$newDir .= $entries{$_};
263	}
264	# replace original directory with new, sorted one
265	substr($$dataPt, $dirStart + 2, 12 * $numEntries) = $newDir;
266	}
267
268	#------------------------------------------------------------------------------
269	# Validate IFD entries (strict validation to test possible chained IFD's)
270	# Inputs: 0) dirInfo ref (must have RAF set), 1) optional DirStart
271	# Returns: true if IFD looks OK
272	sub ValidateIFD($;$)
273	{
274	my ($dirInfo, $dirStart) = @_;
275	my $raf = $$dirInfo{RAF} or return 0;
276	my $base = $$dirInfo{Base};
277	$dirStart = $$dirInfo{DirStart} \|\| 0 unless defined $dirStart;
278	my $offset = $dirStart + ($$dirInfo{DataPos} \|\| 0);
279	my ($buff, $index);
280	$raf->Seek($offset + $base, 0) and $raf->Read($buff,2) == 2 or return 0;
281	my $numEntries = Get16u(\$buff,0);
282	$numEntries > 1 and $numEntries < 64 or return 0;
283	my $len = 12 * $numEntries;
284	$raf->Read($buff, $len) == $len or return 0;
285	my $lastID = -1;
286	for ($index=0; $index<$numEntries; ++$index) {
287	my $entry = 12 * $index;
288	my $tagID = Get16u(\$buff, $entry);
289	$tagID > $lastID or $$dirInfo{AllowOutOfOrderTags} or return 0;
290	my $format = Get16u(\$buff, $entry+2);
291	$format > 0 and $format <= 13 or return 0;
292	my $count = Get32u(\$buff, $entry+4);
293	$count > 0 or return 0;
294	$lastID = $tagID;
295	}
296	return 1;
297	}
298
299	#------------------------------------------------------------------------------
300	# Get sorted list of offsets used in IFD
301	# Inputs: 0) data ref, 1) directory start, 2) dataPos, 3) IFD entries, 4) tag table ref
302	# Returns: 0) sorted list of offsets (only offsets after the end of the IFD)
303	# 1) hash of list indices keyed by offset value
304	# Notes: This is used in a patch to fix the count for tags in Kodak SubIFD3
305	sub GetOffList($$$$$)
306	{
307	my ($dataPt, $dirStart, $dataPos, $numEntries, $tagTablePtr) = @_;
308	my $ifdEnd = $dirStart + 2 + 12 * $numEntries + $dataPos;
309	my ($index, $offset, %offHash);
310	for ($index=0; $index<$numEntries; ++$index) {
311	my $entry = $dirStart + 2 + 12 * $index;
312	my $format = Get16u($dataPt, $entry + 2);
313	next if $format < 1 or $format > 13;
314	my $count = Get16u($dataPt, $entry + 4);
315	my $size = $formatSize[$format] * $count;
316	if ($size <= 4) {
317	my $tagID = Get16u($dataPt, $entry);
318	next unless ref $$tagTablePtr{$tagID} eq 'HASH' and $$tagTablePtr{$tagID}{FixCount};
319	}
320	my $offset = Get16u($dataPt, $entry + 8);
321	$offHash{$offset} = 1 if $offset >= $ifdEnd;
322	}
323	# set offset hash values to indices in list
324	my @offList = sort keys %offHash;
325	$index = 0;
326	foreach $offset (@offList) {
327	$offHash{$offset} = $index++;
328	}
329	return(\@offList, \%offHash);
330	}
331
332	#------------------------------------------------------------------------------
333	# Update TIFF_END member if defined
334	# Inputs: 0) ExifTool ref, 1) end of valid TIFF data
335	sub UpdateTiffEnd($$)
336	{
337	my ($et, $end) = @_;
338	if (defined $$et{TIFF_END} and
339	$$et{TIFF_END} < $end)
340	{
341	$$et{TIFF_END} = $end;
342	}
343	}
344
345	#------------------------------------------------------------------------------
346	# Validate image data size
347	# Inputs: 0) ExifTool ref, 1) validate info hash ref,
348	# 2) flag to issue error (ie. we're writing)
349	# - issues warning or error if problems found
350	sub ValidateImageData($$$;$)
351	{
352	local $_;
353	my ($et, $vInfo, $dirName, $errFlag) = @_;
354
355	# determine the expected size of the image data for an uncompressed image
356	# (0x102 BitsPerSample, 0x103 Compression and 0x115 SamplesPerPixel
357	# all default to a value of 1 if they don't exist)
358	if ((not defined $$vInfo{0x103} or $$vInfo{0x103} eq '1') and
359	$$vInfo{0x100} and $$vInfo{0x101} and ($$vInfo{0x117} or $$vInfo{0x145}))
360	{
361	my $samplesPerPix = $$vInfo{0x115} \|\| 1;
362	my @bitsPerSample = $$vInfo{0x102} ? split(' ',$$vInfo{0x102}) : (1) x $samplesPerPix;
363	my $byteCountInfo = $$vInfo{0x117} \|\| $$vInfo{0x145};
364	my $byteCounts = $$byteCountInfo[1];
365	my $totalBytes = 0;
366	$totalBytes += $_ foreach split ' ', $byteCounts;
367	my $minor;
368	$minor = 1 if $$et{DOC_NUM} or $$et{FILE_TYPE} ne 'TIFF';
369	unless (@bitsPerSample == $samplesPerPix) {
370	unless ($$et{FILE_TYPE} eq 'EPS' and @bitsPerSample == 1) {
371	# (just a warning for this problem)
372	my $s = $samplesPerPix eq '1' ? '' : 's';
373	$et->Warn("$dirName BitsPerSample should have $samplesPerPix value$s", $minor);
374	}
375	push @bitsPerSample, $bitsPerSample[0] while @bitsPerSample < $samplesPerPix;
376	foreach (@bitsPerSample) {
377	$et->WarnOnce("$dirName BitsPerSample values are different", $minor) if $_ ne $bitsPerSample[0];
378	$et->WarnOnce("Invalid $dirName BitsPerSample value", $minor) if $_ < 1 or $_ > 32;
379	}
380	}
381	my $bitsPerPixel = 0;
382	$bitsPerPixel += $_ foreach @bitsPerSample;
383	my $expectedBytes = int(($$vInfo{0x100} * $$vInfo{0x101} * $bitsPerPixel + 7) / 8);
384	if ($expectedBytes != $totalBytes and
385	# (this problem seems normal for certain types of RAW files...)
386	$$et{TIFF_TYPE} !~ /^(K25\|KDC\|MEF\|ORF\|SRF)$/)
387	{
388	my ($adj, $minor);
389	if ($expectedBytes > $totalBytes) {
390	$adj = 'Under'; # undersized is a bigger problem because we may lose data
391	$minor = 0 unless $errFlag;
392	} else {
393	$adj = 'Over';
394	$minor = 1;
395	}
396	my $msg = "${adj}sized $dirName $$byteCountInfo[0]{Name} ($totalBytes bytes, but expected $expectedBytes)";
397	if (not defined $minor) {
398	# this is a serious error if we are writing the file and there
399	# is a chance that we may not copy all of the image data
400	# (but make it minor to allow the file to be written anyway)
401	$et->Error($msg, 1);
402	} else {
403	$et->Warn($msg, $minor);
404	}
405	}
406	}
407	}
408
409	#------------------------------------------------------------------------------
410	# Handle error while writing EXIF
411	# Inputs: 0) ExifTool ref, 1) error string, 2) tag table ref
412	# Returns: undef on fatal error, or '' if minor error is ignored
413	sub ExifErr($$$)
414	{
415	my ($et, $errStr, $tagTablePtr) = @_;
416	# MakerNote errors are minor by default
417	my $minor = ($$tagTablePtr{GROUPS}{0} eq 'MakerNotes' or $$et{FILE_TYPE} eq 'MOV');
418	if ($$tagTablePtr{VARS} and $$tagTablePtr{VARS}{MINOR_ERRORS}) {
419	$et->Warn("$errStr. IFD dropped.") and return '' if $minor;
420	$minor = 1;
421	}
422	return undef if $et->Error($errStr, $minor);
423	return '';
424	}
425
426	#------------------------------------------------------------------------------
427	# Read/Write IFD with TIFF-like header (used by DNG 1.2)
428	# Inputs: 0) ExifTool object ref, 1) dirInfo ref, 2) tag table ref
429	# Returns: Reading: 1 on success, otherwise returns 0 and sets a Warning
430	# Writing: new data block or undef on error
431	sub ProcessTiffIFD($$$)
432	{
433	my ($et, $dirInfo, $tagTablePtr) = @_;
434	$et or return 1; # allow dummy access
435	my $raf = $$dirInfo{RAF};
436	my $base = $$dirInfo{Base} \|\| 0;
437	my $dirName = $$dirInfo{DirName};
438	my $magic = $$dirInfo{Subdir}{Magic} \|\| 0x002a;
439	my $buff;
440
441	# structured with a TIFF-like header and relative offsets
442	$raf->Seek($base, 0) and $raf->Read($buff, 8) == 8 or return 0;
443	unless (SetByteOrder(substr($buff,0,2)) and Get16u(\$buff, 2) == $magic) {
444	my $msg = "Invalid $dirName header";
445	if ($$dirInfo{IsWriting}) {
446	$et->Error($msg);
447	return undef;
448	} else {
449	$et->Warn($msg);
450	return 0;
451	}
452	}
453	my $offset = Get32u(\$buff, 4);
454	my %dirInfo = (
455	DirName => $$dirInfo{DirName},
456	Parent => $$dirInfo{Parent},
457	Base => $base,
458	DataPt => \$buff,
459	DataLen => length $buff,
460	DataPos => 0,
461	DirStart => $offset,
462	DirLen => length($buff) - $offset,
463	RAF => $raf,
464	NewDataPos => 8,
465	);
466	if ($$dirInfo{IsWriting}) {
467	# rewrite the Camera Profile IFD
468	my $newDir = WriteExif($et, \%dirInfo, $tagTablePtr);
469	# don't add header if error writing directory ($newDir is undef)
470	# or if directory is being deleted ($newDir is empty)
471	return $newDir unless $newDir;
472	# return directory with TIFF-like header
473	return GetByteOrder() . Set16u($magic) . Set32u(8) . $newDir;
474	}
475	if ($$et{HTML_DUMP}) {
476	my $tip = sprintf("Byte order: %s endian\nIdentifier: 0x%.4x\n%s offset: 0x%.4x",
477	(GetByteOrder() eq 'II') ? 'Little' : 'Big', $magic, $dirName, $offset);
478	$et->HDump($base, 8, "$dirName header", $tip, 0);
479	}
480	return ProcessExif($et, \%dirInfo, $tagTablePtr);
481	}
482
483	#------------------------------------------------------------------------------
484	# Write EXIF directory
485	# Inputs: 0) ExifTool object ref, 1) source dirInfo ref, 2) tag table ref
486	# Returns: Exif data block (may be empty if no Exif data) or undef on error
487	# Notes: Increments ExifTool CHANGED flag for each tag changed. Also updates
488	# TIFF_END if defined with location of end of original TIFF image.
489	# Returns IFD data in the following order:
490	# 1. IFD0 directory followed by its data
491	# 2. SubIFD directory followed by its data, thumbnail and image
492	# 3. GlobalParameters, EXIF, GPS, Interop IFD's each with their data
493	# 4. IFD1,IFD2,... directories each followed by their data
494	# 5. Thumbnail and/or image data for each IFD, with IFD0 image last
495	sub WriteExif($$$)
496	{
497	my ($et, $dirInfo, $tagTablePtr) = @_;
498	$et or return 1; # allow dummy access to autoload this package
499	my $origDirInfo = $dirInfo; # save original dirInfo
500	my $dataPt = $$dirInfo{DataPt};
501	unless ($dataPt) {
502	my $emptyData = '';
503	$dataPt = \$emptyData;
504	}
505	my $dataPos = $$dirInfo{DataPos} \|\| 0;
506	my $dirStart = $$dirInfo{DirStart} \|\| 0;
507	my $dataLen = $$dirInfo{DataLen} \|\| length($$dataPt);
508	my $dirLen = $$dirInfo{DirLen} \|\| ($dataLen - $dirStart);
509	my $base = $$dirInfo{Base} \|\| 0;
510	my $firstBase = $base;
511	my $raf = $$dirInfo{RAF};
512	my $dirName = $$dirInfo{DirName} \|\| 'unknown';
513	my $fixup = $$dirInfo{Fixup} \|\| new Image::ExifTool::Fixup;
514	my $imageDataFlag = $$dirInfo{ImageData} \|\| '';
515	my $verbose = $et->Options('Verbose');
516	my $out = $et->Options('TextOut');
517	my ($nextIfdPos, %offsetData, $inMakerNotes);
518	my (@offsetInfo, %validateInfo, %xDelete, $strEnc);
519	my $deleteAll = 0;
520	my $newData = ''; # initialize buffer to receive new directory data
521	my @imageData; # image data blocks to copy later if requested
522	my $name = $$dirInfo{Name};
523	$name = $dirName unless $name and $dirName eq 'MakerNotes' and $name !~ /^MakerNote/;
524
525	# save byte order of existing EXIF
526	$$et{SaveExifByteOrder} = GetByteOrder() if $dirName eq 'IFD0' or $dirName eq 'ExifIFD';
527
528	# set encoding for strings
529	$strEnc = $et->Options('CharsetEXIF') if $$tagTablePtr{GROUPS}{0} eq 'EXIF';
530
531	# allow multiple IFD's in IFD0-IFD1-IFD2... chain
532	$$dirInfo{Multi} = 1 if $dirName =~ /^(IFD0\|SubIFD)$/ and not defined $$dirInfo{Multi};
533	$inMakerNotes = 1 if $$tagTablePtr{GROUPS}{0} eq 'MakerNotes';
534	my $ifd;
535
536	#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
537	# loop through each IFD
538	#
539	for ($ifd=0; ; ++$ifd) { # loop through multiple IFD's
540
541	# make sure that Compression and SubfileType are defined for this IFD (for Condition's)
542	$$et{Compression} = $$et{SubfileType} = '';
543
544	# save pointer to start of this IFD within the newData
545	my $newStart = length($newData);
546	my @subdirs; # list of subdirectory data and tag table pointers
547	# determine if directory is contained within our data
548	my $mustRead;
549	if ($dirStart < 0 or $dirStart > $dataLen-2) {
550	$mustRead = 1;
551	} elsif ($dirLen >= 2) {
552	my $len = 2 + 12 * Get16u($dataPt, $dirStart);
553	$mustRead = 1 if $dirStart + $len > $dataLen;
554	}
555	# read IFD from file if necessary
556	if ($mustRead) {
557	if ($raf) {
558	# read the count of entries in this IFD
559	my $offset = $dirStart + $dataPos;
560	my ($buff, $buf2);
561	unless ($raf->Seek($offset + $base, 0) and $raf->Read($buff,2) == 2) {
562	return ExifErr($et, "Bad IFD or truncated file in $name", $tagTablePtr);
563	}
564	my $len = 12 * Get16u(\$buff,0);
565	# (also read next IFD pointer if available)
566	unless ($raf->Read($buf2, $len+4) >= $len) {
567	return ExifErr($et, "Error reading $name", $tagTablePtr);
568	}
569	$buff .= $buf2;
570	# make copy of dirInfo since we're going to modify it
571	my %newDirInfo = %$dirInfo;
572	$dirInfo = \%newDirInfo;
573	# update directory parameters for the newly loaded IFD
574	$dataPt = $$dirInfo{DataPt} = \$buff;
575	$dirStart = $$dirInfo{DirStart} = 0;
576	$dataPos = $$dirInfo{DataPos} = $offset;
577	$dataLen = $$dirInfo{DataLen} = length $buff;
578	$dirLen = $$dirInfo{DirLen} = $dataLen;
579	# only account for nextIFD pointer if we are going to use it
580	$len += 4 if $dataLen==$len+6 and ($$dirInfo{Multi} or $buff =~ /\0{4}$/);
581	UpdateTiffEnd($et, $offset+$base+2+$len);
582	} elsif ($dirLen and $dirStart + 4 >= $dataLen) {
583	# error if we can't load IFD (unless we are creating
584	# from scratch, in which case dirLen will be zero)
585	my $str = $et->Options('IgnoreMinorErrors') ? 'Deleted bad' : 'Bad';
586	$et->Error("$str $name directory", 1);
587	}
588	}
589	my ($index, $dirEnd, $numEntries);
590	if ($dirStart + 4 < $dataLen) {
591	$numEntries = Get16u($dataPt, $dirStart);
592	$dirEnd = $dirStart + 2 + 12 * $numEntries;
593	if ($dirEnd > $dataLen) {
594	my $n = int(($dataLen - $dirStart - 2) / 12);
595	my $rtn = ExifErr($et, "Truncated $name directory", $tagTablePtr);
596	return undef unless $n and defined $rtn;
597	$numEntries = $n; # continue processing the entries we have
598	}
599	# sort entries if necessary (but not in maker notes IFDs)
600	unless ($inMakerNotes) {
601	my $lastID = -1;
602	for ($index=0; $index<$numEntries; ++$index) {
603	my $tagID = Get16u($dataPt, $dirStart + 2 + 12 * $index);
604	# check for proper sequence (but ignore null entries at end)
605	if ($tagID < $lastID and ($tagID or $$tagTablePtr{0})) {
606	SortIFD($dataPt, $dirStart, $numEntries, $$tagTablePtr{0});
607	$et->Warn("Entries in $name were out of sequence. Fixed.",1);
608	last;
609	}
610	$lastID = $tagID;
611	}
612	}
613	} else {
614	$numEntries = 0;
615	$dirEnd = $dirStart;
616	}
617
618	# loop through new values and accumulate all information for this IFD
619	my (%set, %mayDelete, $tagInfo);
620	my $wrongDir = $crossDelete{$dirName};
621	my @newTagInfo = $et->GetNewTagInfoList($tagTablePtr);
622	foreach $tagInfo (@newTagInfo) {
623	my $tagID = $$tagInfo{TagID};
624	# must evaluate Condition later when we have all DataMember's available
625	$set{$tagID} = (ref $$tagTablePtr{$tagID} eq 'ARRAY' or $$tagInfo{Condition}) ? '' : $tagInfo;
626	}
627
628	# fix base offsets (some cameras incorrectly write maker notes in IFD0)
629	if ($dirName eq 'MakerNotes' and $$dirInfo{Parent} =~ /^(ExifIFD\|IFD0)$/ and
630	$$et{TIFF_TYPE} !~ /^(ARW\|SR2)$/ and not $$et{LeicaTrailerPos} and
631	Image::ExifTool::MakerNotes::FixBase($et, $dirInfo))
632	{
633	# update local variables from fixed values
634	$base = $$dirInfo{Base};
635	$dataPos = $$dirInfo{DataPos};
636	# changed if ForceWrite tag was was set to "FixBase"
637	++$$et{CHANGED} if $$et{FORCE_WRITE}{FixBase};
638	if ($$et{TIFF_TYPE} eq 'SRW' and $$et{Make} eq 'SAMSUNG' and $$et{Model} eq 'EK-GN120') {
639	$et->Error("EK-GN120 SRW files are too buggy to write");
640	}
641	}
642
643	# initialize variables to handle mandatory tags
644	my $mandatory = $mandatory{$dirName};
645	my ($allMandatory, $addMandatory);
646	if ($mandatory) {
647	# use X/Y resolution values from JFIF if available
648	if ($dirName eq 'IFD0' and defined $$et{JFIFYResolution}) {
649	my %ifd0Vals = %$mandatory;
650	$ifd0Vals{0x011a} = $$et{JFIFXResolution};
651	$ifd0Vals{0x011b} = $$et{JFIFYResolution};
652	$ifd0Vals{0x0128} = $$et{JFIFResolutionUnit} + 1;
653	$mandatory = \%ifd0Vals;
654	}
655	$allMandatory = $addMandatory = 0; # initialize to zero
656	# add mandatory tags if creating a new directory
657	unless ($numEntries) {
658	foreach (keys %$mandatory) {
659	defined $set{$_} or $set{$_} = $$tagTablePtr{$_};
660	}
661	}
662	} else {
663	undef $deleteAll; # don't remove directory (no mandatory entries)
664	}
665	my ($addDirs, @newTags);
666	if ($inMakerNotes) {
667	$addDirs = { }; # can't currently add new directories in MakerNotes
668	# allow non-permanent makernotes tags to be added
669	# (note: we may get into trouble if there are too many of these
670	# because we allow out-of-order tags in MakerNote IFD's but our
671	# logic to add new tags relies on ordered entries)
672	foreach (keys %set) {
673	next unless $set{$_};
674	my $perm = $set{$_}{Permanent};
675	push @newTags, $_ if defined $perm and not $perm;
676	}
677	@newTags = sort { $a <=> $b } @newTags if @newTags > 1;
678	} else {
679	# get a hash of directories we will be writing in this one
680	$addDirs = $et->GetAddDirHash($tagTablePtr, $dirName);
681	# make a union of tags & dirs (can set whole dirs, like MakerNotes)
682	my %allTags = ( %set, %$addDirs );
683	# make sorted list of new tags to be added
684	@newTags = sort { $a <=> $b } keys(%allTags);
685	}
686	my $dirBuff = ''; # buffer for directory data
687	my $valBuff = ''; # buffer for value data
688	my @valFixups; # list of fixups for offsets in valBuff
689	# fixup for offsets in dirBuff
690	my $dirFixup = new Image::ExifTool::Fixup;
691	my $entryBasedFixup;
692	my $lastTagID = -1;
693	my ($oldInfo, $oldFormat, $oldFormName, $oldCount, $oldSize, $oldValue, $oldImageData);
694	my ($readFormat, $readFormName, $readCount); # format for reading old value(s)
695	my ($entry, $valueDataPt, $valueDataPos, $valueDataLen, $valuePtr, $valEnd);
696	my ($offList, $offHash, $ignoreCount, $fixCount);
697	my $oldID = -1;
698	my $newID = -1;
699
700	# patch for Canon EOS 40D firmware 1.0.4 bug (incorrect directory counts)
701	if ($inMakerNotes and $$et{Model} eq 'Canon EOS 40D') {
702	my $fmt = Get16u($dataPt, $dirStart + 2 + 12 * ($numEntries - 1) + 2);
703	if ($fmt < 1 or $fmt > 13) {
704	# adjust the number of directory entries
705	--$numEntries;
706	$dirEnd -= 12;
707	$ignoreCount = 1;
708	}
709	}
710	#..............................................................................
711	# loop through entries in new directory
712	#
713	$index = 0;
714	Entry: for (;;) {
715
716	if (defined $oldID and $oldID == $newID) {
717	#
718	# read next entry from existing directory
719	#
720	if ($index < $numEntries) {
721	$entry = $dirStart + 2 + 12 * $index;
722	$oldID = Get16u($dataPt, $entry);
723	$readFormat = $oldFormat = Get16u($dataPt, $entry+2);
724	$readCount = $oldCount = Get32u($dataPt, $entry+4);
725	undef $oldImageData;
726	if ($oldFormat < 1 or $oldFormat > 13) {
727	my $msg = "Bad format ($oldFormat) for $name entry $index";
728	# patch to preserve invalid directory entries in SubIFD3 of
729	# various Kodak Z-series cameras (Z812, Z1085IS, Z1275)
730	# and some Sony cameras such as the DSC-P10
731	if ($dirName eq 'MakerNotes' and (($$et{Make}=~/KODAK/i and
732	$$dirInfo{Name} and $$dirInfo{Name} eq 'SubIFD3') or
733	($numEntries == 12 and $$et{Make} eq 'SONY' and $index >= 8)))
734	{
735	$dirBuff .= substr($$dataPt, $entry, 12);
736	++$index;
737	$newID = $oldID; # we wrote this
738	$et->Warn($msg, 1);
739	next;
740	}
741	# don't write out null directory entry
742	if ($oldFormat==0 and $index and $oldCount==0) {
743	$ignoreCount = ($ignoreCount \|\| 0) + 1;
744	# must keep same directory size to avoid messing up our fixed offsets
745	$dirBuff .= ("\0" x 12) if $$dirInfo{FixBase};
746	++$index;
747	$newID = $oldID; # pretend we wrote this
748	next;
749	}
750	return ExifErr($et, $msg, $tagTablePtr);
751	}
752	$readFormName = $oldFormName = $formatName[$oldFormat];
753	$valueDataPt = $dataPt;
754	$valueDataPos = $dataPos;
755	$valueDataLen = $dataLen;
756	$valuePtr = $entry + 8;
757	# try direct method first for speed
758	$oldInfo = $$tagTablePtr{$oldID};
759	if (ref $oldInfo ne 'HASH' or $$oldInfo{Condition}) {
760	# must get unknown tags too
761	# (necessary so we don't miss a tag we want to Drop)
762	my $unk = $et->Options(Unknown => 1);
763	$oldInfo = $et->GetTagInfo($tagTablePtr, $oldID);
764	$et->Options(Unknown => $unk);
765	}
766	# patch incorrect count in Kodak SubIFD3 tags
767	if ($oldCount < 2 and $oldInfo and $$oldInfo{FixCount}) {
768	$offList or ($offList, $offHash) = GetOffList($dataPt, $dirStart, $dataPos,
769	$numEntries, $tagTablePtr);
770	my $i = $$offHash{Get32u($dataPt, $valuePtr)};
771	if (defined $i and $i < $#$offList) {
772	$oldCount = int(($$offList[$i+1] - $$offList[$i]) / $formatSize[$oldFormat]);
773	$fixCount = ($fixCount \|\| 0) + 1 if $oldCount != $readCount;
774	}
775	}
776	$oldSize = $oldCount * $formatSize[$oldFormat];
777	my $readFromFile;
778	if ($oldSize > 4) {
779	$valuePtr = Get32u($dataPt, $valuePtr);
780	# fix valuePtr if necessary
781	if ($$dirInfo{FixOffsets}) {
782	$valEnd or $valEnd = $dataPos + $dirStart + 2 + 12 * $numEntries + 4;
783	my ($tagID, $size, $wFlag) = ($oldID, $oldSize, 1);
784	#### eval FixOffsets ($valuePtr, $valEnd, $size, $tagID, $wFlag)
785	eval $$dirInfo{FixOffsets};
786	unless (defined $valuePtr) {
787	unless ($$et{DropTags}) {
788	my $tagStr = $oldInfo ? $$oldInfo{Name} : sprintf("tag 0x%.4x",$oldID);
789	return undef if $et->Error("Bad $name offset for $tagStr", $inMakerNotes);
790	}
791	++$index; $oldID = $newID; next; # drop this tag
792	}
793	}
794	# offset shouldn't point into TIFF or IFD header
795	my $suspect = ($valuePtr < 8);
796	# convert offset to pointer in $$dataPt
797	if ($$dirInfo{EntryBased} or (ref $$tagTablePtr{$oldID} eq 'HASH' and
798	$$tagTablePtr{$oldID}{EntryBased}))
799	{
800	$valuePtr += $entry;
801	} else {
802	$valuePtr -= $dataPos;
803	}
804	# value shouldn't overlap our directory
805	$suspect = 1 if $valuePtr < $dirEnd and $valuePtr+$oldSize > $dirStart;
806	# get value by seeking in file if we are allowed
807	if ($valuePtr < 0 or $valuePtr+$oldSize > $dataLen) {
808	my ($pos, $tagStr, $invalidPreview, $tmpInfo, $leicaTrailer);
809	if ($oldInfo) {
810	$tagStr = $$oldInfo{Name};
811	$leicaTrailer = $$oldInfo{LeicaTrailer};
812	} elsif (defined $oldInfo) {
813	$tmpInfo = $et->GetTagInfo($tagTablePtr, $oldID, \ '', $oldFormName, $oldCount);
814	if ($tmpInfo) {
815	$tagStr = $$tmpInfo{Name};
816	$leicaTrailer = $$tmpInfo{LeicaTrailer};
817	}
818	}
819	$tagStr or $tagStr = sprintf("tag 0x%.4x",$oldID);
820	# allow PreviewImage to run outside EXIF segment in JPEG images
821	if (not $raf) {
822	if ($tagStr eq 'PreviewImage') {
823	$raf = $$et{RAF};
824	if ($raf) {
825	$pos = $raf->Tell();
826	if ($oldInfo and $$oldInfo{ChangeBase}) {
827	# adjust base offset for this tag only
828	#### eval ChangeBase ($dirStart,$dataPos)
829	my $newBase = eval $$oldInfo{ChangeBase};
830	$valuePtr += $newBase;
831	}
832	} else {
833	$invalidPreview = 1;
834	}
835	} elsif ($leicaTrailer) {
836	# save information about Leica makernote trailer
837	$$et{LeicaTrailer} = {
838	TagInfo => $oldInfo \|\| $tmpInfo,
839	Offset => $base + $valuePtr + $dataPos,
840	Size => $oldSize,
841	Fixup => new Image::ExifTool::Fixup,
842	},
843	$invalidPreview = 2;
844	# remove SubDirectory to prevent processing (for now)
845	my %copy = %{$oldInfo \|\| $tmpInfo};
846	delete $copy{SubDirectory};
847	delete $copy{MakerNotes};
848	$oldInfo = \%copy;
849	}
850	}
851	if ($oldSize > BINARY_DATA_LIMIT and $$origDirInfo{ImageData} and
852	(not defined $oldInfo or ($oldInfo and
853	(not $$oldInfo{SubDirectory} or $$oldInfo{ReadFromRAF}))))
854	{
855	# copy huge data blocks later instead of loading into memory
856	$oldValue = ''; # dummy empty value
857	# copy this value later unless writing a new value
858	unless (defined $set{$oldID}) {
859	my $pad = $oldSize & 0x01 ? 1 : 0;
860	# save block information to copy later (set directory offset later)
861	$oldImageData = [$base+$valuePtr+$dataPos, $oldSize, $pad];
862	}
863	} elsif ($raf) {
864	my $success = ($raf->Seek($base+$valuePtr+$dataPos, 0) and
865	$raf->Read($oldValue, $oldSize) == $oldSize);
866	if (defined $pos) {
867	$raf->Seek($pos, 0);
868	undef $raf;
869	# (sony A700 has 32-byte header on PreviewImage)
870	unless ($success and $oldValue =~ /^(\xff\xd8\xff\|(.\|.{33})\xd8\xff\xdb)/s) {
871	$invalidPreview = 1;
872	$success = 1; # continue writing directory anyway
873	}
874	}
875	unless ($success) {
876	return undef if $et->Error("Error reading value for $name entry $index", $inMakerNotes);
877	++$index; $oldID = $newID; next; # drop this tag
878	}
879	} elsif (not $invalidPreview) {
880	return undef if $et->Error("Bad $name offset for $tagStr", $inMakerNotes);
881	++$index; $oldID = $newID; next; # drop this tag
882	}
883	if ($invalidPreview) {
884	# set value for invalid preview
885	if ($$et{FILE_TYPE} eq 'JPEG') {
886	# define dummy value for preview (or Leica MakerNote) to write later
887	# (value must be larger than 4 bytes to generate PREVIEW_INFO,
888	# and an even number of bytes so it won't be padded)
889	$oldValue = 'LOAD_PREVIEW';
890	} else {
891	$oldValue = 'none';
892	$oldSize = length $oldValue;
893	}
894	$valuePtr = 0;
895	} else {
896	UpdateTiffEnd($et, $base+$valuePtr+$dataPos+$oldSize);
897	}
898	# update pointers for value just read from file
899	$valueDataPt = \$oldValue;
900	$valueDataPos = $valuePtr + $dataPos;
901	$valueDataLen = $oldSize;
902	$valuePtr = 0;
903	$readFromFile = 1;
904	}
905	if ($suspect) {
906	my $tagStr = $oldInfo ? $$oldInfo{Name} : sprintf('tag 0x%.4x', $oldID);
907	my $str = "Suspicious $name offset for $tagStr";
908	if ($inMakerNotes) {
909	$et->Warn($str, 1);
910	} else {
911	return undef if $et->Error($str, 1);
912	}
913	}
914	}
915	# read value if we haven't already
916	$oldValue = substr($$valueDataPt, $valuePtr, $oldSize) unless $readFromFile;
917	# get tagInfo using value if necessary
918	if (defined $oldInfo and not $oldInfo) {
919	my $unk = $et->Options(Unknown => 1);
920	$oldInfo = $et->GetTagInfo($tagTablePtr, $oldID, \$oldValue, $oldFormName, $oldCount);
921	$et->Options(Unknown => $unk);
922	# now that we have the value, we can resolve the Condition to finally
923	# determine whether we want to delete this tag or not
924	if ($mayDelete{$oldID} and $oldInfo and (not @newTags or $newTags[0] != $oldID)) {
925	my $nvHash = $et->GetNewValueHash($oldInfo, $dirName);
926	if (not $nvHash and $wrongDir) {
927	# delete from wrong directory if necessary
928	$nvHash = $et->GetNewValueHash($oldInfo, $wrongDir);
929	$nvHash and $xDelete{$oldID} = 1;
930	}
931	if ($nvHash) {
932	# we want to delete this tag after all, so insert it into our list
933	$set{$oldID} = $oldInfo;
934	unshift @newTags, $oldID;
935	}
936	}
937	}
938	# make sure we are handling the 'ifd' format properly
939	if (($oldFormat == 13 or $oldFormat == 18) and
940	(not $oldInfo or not $$oldInfo{SubIFD}))
941	{
942	my $str = sprintf('%s tag 0x%.4x IFD format not handled', $name, $oldID);
943	$et->Error($str, $inMakerNotes);
944	}
945	# override format we use to read the value if specified
946	if ($oldInfo) {
947	# check for tags which must be integers
948	if (($$oldInfo{IsOffset} or $$oldInfo{SubIFD}) and
949	not $intFormat{$oldFormName})
950	{
951	$et->Error("Invalid format ($oldFormName) for $name $$oldInfo{Name}", $inMakerNotes);
952	++$index; $oldID = $newID; next; # drop this tag
953	}
954	if ($$oldInfo{Drop} and $$et{DropTags} and
955	($$oldInfo{Drop} == 1 or $$oldInfo{Drop} < $oldSize))
956	{
957	++$index; $oldID = $newID; next; # drop this tag
958	}
959	if ($$oldInfo{Format}) {
960	$readFormName = $$oldInfo{Format};
961	$readFormat = $formatNumber{$readFormName};
962	unless ($readFormat) {
963	# we aren't reading in a standard EXIF format, so rewrite in old format
964	$readFormName = $oldFormName;
965	$readFormat = $oldFormat;
966	}
967	if ($$oldInfo{FixedSize}) {
968	$oldSize = $$oldInfo{FixedSize} if $$oldInfo{FixedSize};
969	$oldValue = substr($$valueDataPt, $valuePtr, $oldSize);
970	}
971	# adjust number of items to read if format size changed
972	$readCount = $oldSize / $formatSize[$readFormat];
973	}
974	}
975	if ($oldID <= $lastTagID and not $inMakerNotes) {
976	my $str = $oldInfo ? "$$oldInfo{Name} tag" : sprintf('tag 0x%x',$oldID);
977	if ($oldID == $lastTagID) {
978	$et->Warn("Duplicate $str in $name");
979	# put this tag back into the newTags list if necessary
980	unshift @newTags, $oldID if defined $set{$oldID};
981	} else {
982	$et->Warn("\u$str out of sequence in $name");
983	}
984	}
985	$lastTagID = $oldID;
986	++$index; # increment index for next time
987	} else {
988	undef $oldID; # no more existing entries
989	}
990	}
991	#
992	# write out all new tags, up to and including this one
993	#
994	$newID = $newTags[0];
995	my $isNew; # -1=tag is old, 0=tag same as existing, 1=tag is new
996	if (not defined $oldID) {
997	last unless defined $newID;
998	$isNew = 1;
999	} elsif (not defined $newID) {
1000	# maker notes will have no new tags defined
1001	if (defined $set{$oldID}) {
1002	$newID = $oldID;
1003	$isNew = 0;
1004	} else {
1005	$isNew = -1;
1006	}
1007	} else {
1008	$isNew = $oldID <=> $newID;
1009	}
1010	my $newInfo = $oldInfo;
1011	my $newFormat = $oldFormat;
1012	my $newFormName = $oldFormName;
1013	my $newCount = $oldCount;
1014	my $ifdFormName;
1015	my $newValue;
1016	my $newValuePt = $isNew >= 0 ? \$newValue : \$oldValue;
1017	my $isOverwriting;
1018
1019	if ($isNew >= 0) {
1020	# add, edit or delete this tag
1021	shift @newTags; # remove from list
1022	my $curInfo = $set{$newID};
1023	unless ($curInfo or $$addDirs{$newID}) {
1024	# we can finally get the specific tagInfo reference for this tag
1025	# (because we can now evaluate the Condition statement since all
1026	# DataMember's have been obtained for tags up to this one)
1027	$curInfo = $et->GetTagInfo($tagTablePtr, $newID);
1028	if (defined $curInfo and not $curInfo) {
1029	# need value to evaluate the condition
1030	# (tricky because we need the tagInfo ref to get the value,
1031	# so we must loop through all new tagInfo's...)
1032	foreach $tagInfo (@newTagInfo) {
1033	next unless $$tagInfo{TagID} == $newID;
1034	my $val = $et->GetNewValue($tagInfo);
1035	defined $val or $mayDelete{$newID} = 1, next;
1036	# must convert to binary for evaluating in Condition
1037	my $fmt = $$tagInfo{Format} \|\| $$tagInfo{Writable};
1038	if ($fmt) {
1039	$val = WriteValue($val, $fmt, $$tagInfo{Count});
1040	defined $val or $mayDelete{$newID} = 1, next;
1041	}
1042	$curInfo = $et->GetTagInfo($tagTablePtr, $newID, \$val, $oldFormName, $oldCount);
1043	if ($curInfo) {
1044	last if $curInfo eq $tagInfo;
1045	undef $curInfo;
1046	}
1047	}
1048	# may want to delete this, but we need to see the old value first
1049	$mayDelete{$newID} = 1 unless $curInfo;
1050	}
1051	# don't set this tag unless valid for the current condition
1052	if ($curInfo and $$et{NEW_VALUE}{$curInfo}) {
1053	$set{$newID} = $curInfo;
1054	} else {
1055	next if $isNew > 0;
1056	$isNew = -1;
1057	undef $curInfo;
1058	}
1059	}
1060	if ($curInfo) {
1061	if ($$curInfo{WriteCondition}) {
1062	my $self = $et; # set $self to be used in eval
1063	#### eval WriteCondition ($self)
1064	unless (eval $$curInfo{WriteCondition}) {
1065	$@ and warn $@;
1066	goto NoWrite; # GOTO !
1067	}
1068	}
1069	my $nvHash;
1070	$nvHash = $et->GetNewValueHash($curInfo, $dirName) if $isNew >= 0;
1071	unless ($nvHash or defined $$mandatory{$newID}) {
1072	goto NoWrite unless $wrongDir; # GOTO !
1073	# delete stuff from the wrong directory if setting somewhere else
1074	$nvHash = $et->GetNewValueHash($curInfo, $wrongDir);
1075	# don't cross delete if not overwriting
1076	goto NoWrite unless $et->IsOverwriting($nvHash); # GOTO !
1077	# don't cross delete if specifically deleting from the other directory
1078	# (Note: don't call GetValue() here because it shouldn't be called
1079	# if IsOverwriting returns < 0 -- eg. when shifting)
1080	if (not defined $$nvHash{Value} and $$nvHash{WantGroup} and
1081	lc($$nvHash{WantGroup}) eq lc($wrongDir))
1082	{
1083	goto NoWrite; # GOTO !
1084	} else {
1085	# remove this tag if found in this IFD
1086	$xDelete{$newID} = 1;
1087	}
1088	}
1089	} elsif (not $$addDirs{$newID}) {
1090	NoWrite: next if $isNew > 0;
1091	delete $set{$newID};
1092	$isNew = -1;
1093	}
1094	if ($set{$newID}) {
1095	#
1096	# set the new tag value (or 'next' if deleting tag)
1097	#
1098	$newInfo = $set{$newID};
1099	$newCount = $$newInfo{Count};
1100	my ($val, $newVal, $n);
1101	my $nvHash = $et->GetNewValueHash($newInfo, $dirName);
1102	if ($isNew > 0) {
1103	# don't create new entry unless requested
1104	if ($nvHash) {
1105	next unless $$nvHash{IsCreating};
1106	if ($$newInfo{IsOverwriting}) {
1107	my $proc = $$newInfo{IsOverwriting};
1108	$isOverwriting = &$proc($et, $nvHash, $val, \$newVal);
1109	} else {
1110	$isOverwriting = $et->IsOverwriting($nvHash);
1111	}
1112	} else {
1113	next if $xDelete{$newID}; # don't create if cross deleting
1114	$newVal = $$mandatory{$newID}; # get value for mandatory tag
1115	$isOverwriting = 1;
1116	}
1117	# convert using new format
1118	if ($$newInfo{Format}) {
1119	$newFormName = $$newInfo{Format};
1120	# use Writable flag to specify IFD format code
1121	$ifdFormName = $$newInfo{Writable};
1122	} else {
1123	$newFormName = $$newInfo{Writable};
1124	unless ($newFormName) {
1125	warn("No format for $name $$newInfo{Name}\n");
1126	next;
1127	}
1128	}
1129	$newFormat = $formatNumber{$newFormName};
1130	} elsif ($nvHash or $xDelete{$newID}) {
1131	unless ($nvHash) {
1132	$nvHash = $et->GetNewValueHash($newInfo, $wrongDir);
1133	}
1134	# read value
1135	if (length $oldValue >= $oldSize) {
1136	$val = ReadValue(\$oldValue, 0, $readFormName, $readCount, $oldSize);
1137	} else {
1138	$val = '';
1139	}
1140	# determine write format (by default, use 'Writable' format)
1141	my $writable = $$newInfo{Writable};
1142	# (or use existing format if 'Writable' not specified)
1143	$writable = $oldFormName unless $writable and $writable ne '1';
1144	# (and override write format with 'Format' if specified)
1145	my $writeForm = $$newInfo{Format} \|\| $writable;
1146	if ($writeForm ne $newFormName) {
1147	# write in specified format
1148	$newFormName = $writeForm;
1149	$newFormat = $formatNumber{$newFormName};
1150	# use different IFD format code if necessary
1151	if ($inMakerNotes) {
1152	# always preserve IFD format in maker notes
1153	$ifdFormName = $oldFormName;
1154	} elsif ($writable ne $newFormName) {
1155	# use specified IFD format
1156	$ifdFormName = $writable;
1157	}
1158	}
1159	if ($inMakerNotes and $readFormName ne 'string' and $readFormName ne 'undef') {
1160	# keep same size in maker notes unless string or binary
1161	$newCount = $oldCount * $formatSize[$oldFormat] / $formatSize[$newFormat];
1162	}
1163	if ($$newInfo{IsOverwriting}) {
1164	my $proc = $$newInfo{IsOverwriting};
1165	$isOverwriting = &$proc($et, $nvHash, $val, \$newVal);
1166	} else {
1167	$isOverwriting = $et->IsOverwriting($nvHash, $val);
1168	}
1169	}
1170	if ($isOverwriting) {
1171	$newVal = $et->GetNewValue($nvHash) unless defined $newVal;
1172	# value undefined if deleting this tag
1173	# (also delete tag if cross-deleting and this isn't a date/time shift)
1174	if (not defined $newVal or ($xDelete{$newID} and not defined $$nvHash{Shift})) {
1175	if (not defined $newVal and $$newInfo{RawConvInv} and defined $$nvHash{Value}) {
1176	# error in RawConvInv, so rewrite existing tag
1177	goto NoOverwrite; # GOTO!
1178	}
1179	unless ($isNew) {
1180	++$$et{CHANGED};
1181	$et->VerboseValue("- $dirName:$$newInfo{Name}", $val);
1182	}
1183	next;
1184	}
1185	if ($newCount and $newCount < 0) {
1186	# set count to number of values if variable
1187	my @vals = split ' ',$newVal;
1188	$newCount = @vals;
1189	}
1190	# convert to binary format
1191	$newValue = WriteValue($newVal, $newFormName, $newCount);
1192	unless (defined $newValue) {
1193	$et->Warn("Invalid value for $dirName:$$newInfo{Name}");
1194	goto NoOverwrite; # GOTO!
1195	}
1196	if (length $newValue) {
1197	# limit maximum value length in JPEG images
1198	# (max segment size is 65533 bytes and the min EXIF size is 96 incl an additional IFD entry)
1199	if ($$et{FILE_TYPE} eq 'JPEG' and length($newValue) > 65436 and
1200	$$newInfo{Name} ne 'PreviewImage')
1201	{
1202	my $name = $$newInfo{MakerNotes} ? 'MakerNotes' : $$newInfo{Name};
1203	$et->Warn("Writing large value for $name",1);
1204	}
1205	# re-code if necessary
1206	if ($strEnc and $newFormName eq 'string') {
1207	$newValue = $et->Encode($newValue, $strEnc);
1208	}
1209	} else {
1210	$et->Warn("Can't write zero length $$newInfo{Name} in $$tagTablePtr{GROUPS}{1}");
1211	goto NoOverwrite; # GOTO!
1212	}
1213	if ($isNew >= 0) {
1214	$newCount = length($newValue) / $formatSize[$newFormat];
1215	++$$et{CHANGED};
1216	if (defined $allMandatory) {
1217	# not all mandatory if we are writing any tag specifically
1218	if ($nvHash) {
1219	undef $allMandatory;
1220	undef $deleteAll;
1221	} else {
1222	++$addMandatory; # count mandatory tags that we added
1223	}
1224	}
1225	if ($verbose > 1) {
1226	$et->VerboseValue("- $dirName:$$newInfo{Name}", $val) unless $isNew;
1227	if ($$newInfo{OffsetPair} and $newVal eq '4277010157') { # (0xfeedfeed)
1228	print { $$et{OPTIONS}{TextOut} } " + $dirName:$$newInfo{Name} = <tbd>\n";
1229	} else {
1230	my $str = $nvHash ? '' : ' (mandatory)';
1231	$et->VerboseValue("+ $dirName:$$newInfo{Name}", $newVal, $str);
1232	}
1233	}
1234	}
1235	} else {
1236	NoOverwrite: next if $isNew > 0;
1237	$isNew = -1; # rewrite existing tag
1238	}
1239	# set format for EXIF IFD if different than conversion format
1240	if ($ifdFormName) {
1241	$newFormName = $ifdFormName;
1242	$newFormat = $formatNumber{$newFormName};
1243	}
1244
1245	} elsif ($isNew > 0) {
1246	#
1247	# create new subdirectory
1248	#
1249	# newInfo may not be defined if we try to add a mandatory tag
1250	# to a directory that doesn't support it (eg. IFD1 in RW2 images)
1251	$newInfo = $$addDirs{$newID} or next;
1252	# make sure we don't try to generate a new MakerNotes directory
1253	# or a SubIFD
1254	next if $$newInfo{MakerNotes} or $$newInfo{Name} eq 'SubIFD';
1255	my $subTable;
1256	if ($$newInfo{SubDirectory}{TagTable}) {
1257	$subTable = Image::ExifTool::GetTagTable($$newInfo{SubDirectory}{TagTable});
1258	} else {
1259	$subTable = $tagTablePtr;
1260	}
1261	# create empty source directory
1262	my %sourceDir = (
1263	Parent => $dirName,
1264	Fixup => new Image::ExifTool::Fixup,
1265	);
1266	$sourceDir{DirName} = $$newInfo{Groups}{1} if $$newInfo{SubIFD};
1267	$newValue = $et->WriteDirectory(\%sourceDir, $subTable);
1268	# only add new directory if it isn't empty
1269	next unless defined $newValue and length($newValue);
1270	# set the fixup start location
1271	if ($$newInfo{SubIFD}) {
1272	# subdirectory is referenced by an offset in value buffer
1273	my $subdir = $newValue;
1274	$newValue = Set32u(0xfeedf00d);
1275	push @subdirs, {
1276	DataPt => \$subdir,
1277	Table => $subTable,
1278	Fixup => $sourceDir{Fixup},
1279	Offset => length($dirBuff) + 8,
1280	Where => 'dirBuff',
1281	};
1282	$newFormName = 'int32u';
1283	$newFormat = $formatNumber{$newFormName};
1284	} else {
1285	# subdirectory goes directly into value buffer
1286	$sourceDir{Fixup}{Start} += length($valBuff);
1287	# use Writable to set format, otherwise 'undef'
1288	$newFormName = $$newInfo{Writable};
1289	unless ($newFormName and $formatNumber{$newFormName}) {
1290	$newFormName = 'undef';
1291	}
1292	$newFormat = $formatNumber{$newFormName};
1293	push @valFixups, $sourceDir{Fixup};
1294	}
1295	} elsif ($$newInfo{Format} and $$newInfo{Writable} and $$newInfo{Writable} ne '1') {
1296	# use specified write format
1297	$newFormName = $$newInfo{Writable};
1298	$newFormat = $formatNumber{$newFormName};
1299	} elsif ($$addDirs{$newID} and $newInfo ne $$addDirs{$newID}) {
1300	# this can happen if we are trying to add a directory that doesn't exist
1301	# in this type of file (eg. try adding a SubIFD tag to an A100 image)
1302	$isNew = -1;
1303	}
1304	}
1305	if ($isNew < 0) {
1306	# just rewrite existing tag
1307	$newID = $oldID;
1308	$newValue = $oldValue;
1309	$newFormat = $oldFormat; # (just in case it changed)
1310	$newFormName = $oldFormName;
1311	# set offset of this entry in the directory so we can update the pointer
1312	# and save block information to copy this large block later
1313	if ($oldImageData) {
1314	$$oldImageData[3] = $newStart + length($dirBuff) + 2;
1315	push @imageData, $oldImageData;
1316	$$origDirInfo{ImageData} = \@imageData;
1317	}
1318	}
1319	if ($newInfo) {
1320	#
1321	# load necessary data for this tag (thumbnail image, etc)
1322	#
1323	if ($$newInfo{DataTag} and $isNew >= 0) {
1324	my $dataTag = $$newInfo{DataTag};
1325	# load data for this tag
1326	unless (defined $offsetData{$dataTag} or $dataTag eq 'LeicaTrailer') {
1327	# prefer tag from Composite table if it exists (otherwise
1328	# PreviewImage data would be taken from Extra tag)
1329	my $compInfo = Image::ExifTool::GetCompositeTagInfo($dataTag);
1330	$offsetData{$dataTag} = $et->GetNewValue($compInfo \|\| $dataTag);
1331	my $err;
1332	if (defined $offsetData{$dataTag}) {
1333	my $len = length $offsetData{$dataTag};
1334	if ($dataTag eq 'PreviewImage') {
1335	# must set DEL_PREVIEW flag now if preview fit into IFD
1336	$$et{DEL_PREVIEW} = 1 if $len <= 4;
1337	}
1338	} else {
1339	$err = "$dataTag not found";
1340	}
1341	if ($err) {
1342	$et->Warn($err) if $$newInfo{IsOffset};
1343	delete $set{$newID}; # remove from list of tags we are setting
1344	next;
1345	}
1346	}
1347	}
1348	#
1349	# write maker notes
1350	#
1351	if ($$newInfo{MakerNotes}) {
1352	# don't write new makernotes if we are deleting this group
1353	if ($$et{DEL_GROUP}{MakerNotes} and
1354	($$et{DEL_GROUP}{MakerNotes} != 2 or $isNew <= 0))
1355	{
1356	if ($et->IsRawType()) {
1357	$et->WarnOnce("Can't delete MakerNotes from $$et{FileType}",1);
1358	} else {
1359	if ($isNew <= 0) {
1360	++$$et{CHANGED};
1361	$verbose and print $out " Deleting MakerNotes\n";
1362	}
1363	next;
1364	}
1365	}
1366	my $saveOrder = GetByteOrder();
1367	if ($isNew >= 0 and defined $set{$newID}) {
1368	# we are writing a whole new maker note block
1369	# --> add fixup information if necessary
1370	my $nvHash = $et->GetNewValueHash($newInfo, $dirName);
1371	if ($nvHash and $$nvHash{MAKER_NOTE_FIXUP}) {
1372	# must clone fixup because we will be shifting it
1373	my $makerFixup = $$nvHash{MAKER_NOTE_FIXUP}->Clone();
1374	my $valLen = length($valBuff);
1375	$$makerFixup{Start} += $valLen;
1376	push @valFixups, $makerFixup;
1377	}
1378	} else {
1379	# update maker notes if possible
1380	my %subdirInfo = (
1381	Base => $base,
1382	DataPt => $valueDataPt,
1383	DataPos => $valueDataPos,
1384	DataLen => $valueDataLen,
1385	DirStart => $valuePtr,
1386	DirLen => $oldSize,
1387	DirName => 'MakerNotes',
1388	Name => $$newInfo{Name},
1389	Parent => $dirName,
1390	TagInfo => $newInfo,
1391	RAF => $raf,
1392	);
1393	my ($subTable, $subdir, $loc, $writeProc, $notIFD);
1394	if ($$newInfo{SubDirectory}) {
1395	my $sub = $$newInfo{SubDirectory};
1396	$subdirInfo{FixBase} = 1 if $$sub{FixBase};
1397	$subdirInfo{FixOffsets} = $$sub{FixOffsets};
1398	$subdirInfo{EntryBased} = $$sub{EntryBased};
1399	$subdirInfo{NoFixBase} = 1 if defined $$sub{Base};
1400	$subdirInfo{AutoFix} = $$sub{AutoFix};
1401	SetByteOrder($$sub{ByteOrder}) if $$sub{ByteOrder};
1402	}
1403	# get the proper tag table for these maker notes
1404	if ($oldInfo and $$oldInfo{SubDirectory}) {
1405	$subTable = $$oldInfo{SubDirectory}{TagTable};
1406	$subTable and $subTable = Image::ExifTool::GetTagTable($subTable);
1407	$writeProc = $$oldInfo{SubDirectory}{WriteProc};
1408	$notIFD = $$oldInfo{NotIFD};
1409	} else {
1410	$et->Warn('Internal problem getting maker notes tag table');
1411	}
1412	$writeProc or $writeProc = $$subTable{WRITE_PROC} if $subTable;
1413	$subTable or $subTable = $tagTablePtr;
1414	if ($writeProc and
1415	$writeProc eq \&Image::ExifTool::MakerNotes::WriteUnknownOrPreview and
1416	$oldValue =~ /^\xff\xd8\xff/)
1417	{
1418	$loc = 0;
1419	} elsif (not $notIFD) {
1420	# look for IFD-style maker notes
1421	$loc = Image::ExifTool::MakerNotes::LocateIFD($et,\%subdirInfo);
1422	}
1423	if (defined $loc) {
1424	# we need fixup data for this subdirectory
1425	$subdirInfo{Fixup} = new Image::ExifTool::Fixup;
1426	# rewrite maker notes
1427	my $changed = $$et{CHANGED};
1428	$subdir = $et->WriteDirectory(\%subdirInfo, $subTable, $writeProc);
1429	if ($changed == $$et{CHANGED} and $subdirInfo{Fixup}->IsEmpty()) {
1430	# return original data if nothing changed and no fixups
1431	undef $subdir;
1432	}
1433	} elsif ($$subTable{PROCESS_PROC} and
1434	$$subTable{PROCESS_PROC} eq \&Image::ExifTool::ProcessBinaryData)
1435	{
1436	my $sub = $$oldInfo{SubDirectory};
1437	if (defined $$sub{Start}) {
1438	#### eval Start ($valuePtr)
1439	my $start = eval $$sub{Start};
1440	$loc = $start - $valuePtr;
1441	$subdirInfo{DirStart} = $start;
1442	$subdirInfo{DirLen} -= $loc;
1443	} else {
1444	$loc = 0;
1445	}
1446	# rewrite maker notes
1447	$subdir = $et->WriteDirectory(\%subdirInfo, $subTable);
1448	} elsif ($notIFD) {
1449	if ($writeProc) {
1450	$loc = 0;
1451	$subdir = $et->WriteDirectory(\%subdirInfo, $subTable);
1452	}
1453	} else {
1454	my $msg = 'Maker notes could not be parsed';
1455	if ($$et{FILE_TYPE} eq 'JPEG') {
1456	$et->Warn($msg, 1);
1457	} else {
1458	$et->Error($msg, 1);
1459	}
1460	}
1461	if (defined $subdir) {
1462	length $subdir or SetByteOrder($saveOrder), next;
1463	my $valLen = length($valBuff);
1464	# restore existing header and substitute the new
1465	# maker notes for the old value
1466	$newValue = substr($oldValue, 0, $loc) . $subdir;
1467	my $makerFixup = $subdirInfo{Fixup};
1468	my $previewInfo = $$et{PREVIEW_INFO};
1469	if ($subdirInfo{Relative}) {
1470	# apply a one-time fixup to $loc since offsets are relative
1471	$$makerFixup{Start} += $loc;
1472	# shift all offsets to be relative to new base
1473	my $baseShift = $valueDataPos + $valuePtr + $base - $subdirInfo{Base};
1474	$$makerFixup{Shift} += $baseShift;
1475	$makerFixup->ApplyFixup(\$newValue);
1476	if ($previewInfo) {
1477	# remove all but PreviewImage fixup (since others shouldn't change)
1478	foreach (keys %{$$makerFixup{Pointers}}) {
1479	/_PreviewImage$/ or delete $$makerFixup{Pointers}{$_};
1480	}
1481	# zero pointer so we can see how it gets shifted later
1482	$makerFixup->SetMarkerPointers(\$newValue, 'PreviewImage', 0);
1483	# set the pointer to the start of the EXIF information
1484	# add preview image fixup to list of value fixups
1485	$$makerFixup{Start} += $valLen;
1486	push @valFixups, $makerFixup;
1487	$$previewInfo{BaseShift} = $baseShift;
1488	$$previewInfo{Relative} = 1;
1489	}
1490	# don't shift anything if relative flag set to zero (Pentax patch)
1491	} elsif (not defined $subdirInfo{Relative}) {
1492	# shift offset base if shifted in the original image or if FixBase
1493	# was used, but be careful of automatic FixBase with negative shifts
1494	# since they may lead to negative (invalid) offsets (casio_edit_problem.jpg)
1495	my $baseShift = $base - $subdirInfo{Base};
1496	if ($subdirInfo{AutoFix}) {
1497	$baseShift = 0;
1498	} elsif ($subdirInfo{FixBase} and $baseShift < 0 and
1499	# allow negative base shift if offsets are bigger (PentaxOptioWP.jpg)
1500	(not $subdirInfo{MinOffset} or $subdirInfo{MinOffset} + $baseShift < 0))
1501	{
1502	my $fixBase = $et->Options('FixBase');
1503	if (not defined $fixBase) {
1504	my $str = $et->Options('IgnoreMinorErrors') ? 'ignored' : 'fix or ignore?';
1505	$et->Error("MakerNotes offsets may be incorrect ($str)", 1);
1506	} elsif ($fixBase eq '') {
1507	$et->Warn('Fixed incorrect MakerNotes offsets');
1508	$baseShift = 0;
1509	}
1510	}
1511	$$makerFixup{Start} += $valLen + $loc;
1512	$$makerFixup{Shift} += $baseShift;
1513	# permanently fix makernote offset errors
1514	$$makerFixup{Shift} += $subdirInfo{FixedBy} \|\| 0;
1515	push @valFixups, $makerFixup;
1516	if ($previewInfo and not $$previewInfo{NoBaseShift}) {
1517	$$previewInfo{BaseShift} = $baseShift;
1518	}
1519	}
1520	$newValuePt = \$newValue; # write new value
1521	}
1522	}
1523	SetByteOrder($saveOrder);
1524
1525	# process existing subdirectory unless we are overwriting it entirely
1526	} elsif ($$newInfo{SubDirectory} and $isNew <= 0 and not $isOverwriting
1527	# don't edit directory if Writable is set to 0
1528	and (not defined $$newInfo{Writable} or $$newInfo{Writable}) and
1529	not $$newInfo{ReadFromRAF})
1530	{
1531
1532	my $subdir = $$newInfo{SubDirectory};
1533	if ($$newInfo{SubIFD}) {
1534	#
1535	# rewrite existing sub IFD's
1536	#
1537	my $subTable = $tagTablePtr;
1538	if ($$subdir{TagTable}) {
1539	$subTable = Image::ExifTool::GetTagTable($$subdir{TagTable});
1540	}
1541	# determine directory name for this IFD
1542	my $subdirName = $$newInfo{Groups}{1} \|\| $$newInfo{Name};
1543	# all makernotes directory names must be 'MakerNotes'
1544	$subdirName = 'MakerNotes' if $$subTable{GROUPS}{0} eq 'MakerNotes';
1545	# must handle sub-IFD's specially since the values
1546	# are actually offsets to subdirectories
1547	unless ($readCount) { # can't have zero count
1548	return undef if $et->Error("$name entry $index has zero count", 2);
1549	next;
1550	}
1551	my $writeCount = 0;
1552	my $i;
1553	$newValue = ''; # reset value because we regenerate it below
1554	for ($i=0; $i<$readCount; ++$i) {
1555	my $off = $i * $formatSize[$readFormat];
1556	my $val = ReadValue($valueDataPt, $valuePtr + $off,
1557	$readFormName, 1, $oldSize - $off);
1558	my $subdirStart = $val - $dataPos;
1559	my $subdirBase = $base;
1560	my $hdrLen;
1561	if (defined $$subdir{Start}) {
1562	#### eval Start ($val)
1563	my $newStart = eval $$subdir{Start};
1564	unless (Image::ExifTool::IsInt($newStart)) {
1565	$et->Error("Bad subdirectory start for $$newInfo{Name}");
1566	next;
1567	}
1568	$newStart -= $dataPos;
1569	$hdrLen = $newStart - $subdirStart;
1570	$subdirStart = $newStart;
1571	}
1572	if ($$subdir{Base}) {
1573	my $start = $subdirStart + $dataPos;
1574	#### eval Base ($start,$base)
1575	$subdirBase += eval $$subdir{Base};
1576	}
1577	# add IFD number if more than one
1578	$subdirName =~ s/\d*$/$i/ if $i;
1579	my %subdirInfo = (
1580	Base => $subdirBase,
1581	DataPt => $dataPt,
1582	DataPos => $dataPos - $subdirBase + $base,
1583	DataLen => $dataLen,
1584	DirStart => $subdirStart,
1585	DirName => $subdirName,
1586	Name => $$newInfo{Name},
1587	TagInfo => $newInfo,
1588	Parent => $dirName,
1589	Fixup => new Image::ExifTool::Fixup,
1590	RAF => $raf,
1591	Subdir => $subdir,
1592	# set ImageData only for 1st level SubIFD's
1593	ImageData=> $imageDataFlag eq 'Main' ? 'SubIFD' : undef,
1594	);
1595	# pass on header pointer only for certain sub IFD's
1596	$subdirInfo{HeaderPtr} = $$dirInfo{HeaderPtr} if $$newInfo{SubIFD} == 2;
1597	if ($$subdir{RelativeBase}) {
1598	# apply one-time fixup if offsets are relative (Sony IDC hack)
1599	delete $subdirInfo{Fixup};
1600	delete $subdirInfo{ImageData};
1601	}
1602	# is the subdirectory outside our current data?
1603	if ($subdirStart < 0 or $subdirStart + 2 > $dataLen) {
1604	if ($raf) {
1605	# reset SubDirectory buffer (we will load it later)
1606	my $buff = '';
1607	$subdirInfo{DataPt} = \$buff;
1608	$subdirInfo{DataLen} = 0;
1609	} else {
1610	my @err = ("Can't read $subdirName data", $inMakerNotes);
1611	if ($$subTable{VARS} and $$subTable{VARS}{MINOR_ERRORS}) {
1612	$et->Warn($err[0] . '. Ignored.');
1613	} elsif ($et->Error(@err)) {
1614	return undef;
1615	}
1616	next Entry; # don't write this directory
1617	}
1618	}
1619	my $subdirData = $et->WriteDirectory(\%subdirInfo, $subTable, $$subdir{WriteProc});
1620	unless (defined $subdirData) {
1621	# WriteDirectory should have issued an error, but check just in case
1622	$et->Error("Error writing $subdirName") unless $$et{VALUE}{Error};
1623	return undef;
1624	}
1625	# add back original header if necessary (eg. Ricoh GR)
1626	if ($hdrLen and $hdrLen > 0 and $subdirStart <= $dataLen) {
1627	$subdirData = substr($$dataPt, $subdirStart - $hdrLen, $hdrLen) . $subdirData;
1628	$subdirInfo{Fixup}{Start} += $hdrLen;
1629	}
1630	unless (length $subdirData) {
1631	next unless $inMakerNotes;
1632	# don't delete MakerNote Sub-IFD's, write empty IFD instead
1633	$subdirData = "\0" x 6;
1634	# reset SubIFD ImageData and Fixup just to be safe
1635	delete $subdirInfo{ImageData};
1636	delete $subdirInfo{Fixup};
1637	}
1638	# handle data blocks that we will transfer later
1639	if (ref $subdirInfo{ImageData}) {
1640	push @imageData, @{$subdirInfo{ImageData}};
1641	$$origDirInfo{ImageData} = \@imageData;
1642	}
1643	# temporarily set value to subdirectory index
1644	# (will set to actual offset later when we know what it is)
1645	$newValue .= Set32u(0xfeedf00d);
1646	my ($offset, $where);
1647	if ($readCount > 1) {
1648	$offset = length($valBuff) + $i * 4;
1649	$where = 'valBuff';
1650	} else {
1651	$offset = length($dirBuff) + 8;
1652	$where = 'dirBuff';
1653	}
1654	# add to list of subdirectories we will append later
1655	push @subdirs, {
1656	DataPt => \$subdirData,
1657	Table => $subTable,
1658	Fixup => $subdirInfo{Fixup},
1659	Offset => $offset,
1660	Where => $where,
1661	ImageData => $subdirInfo{ImageData},
1662	};
1663	++$writeCount; # count number of subdirs written
1664	}
1665	next unless length $newValue;
1666	# must change location of subdir offset if we deleted
1667	# a directory and only one remains
1668	if ($writeCount < $readCount and $writeCount == 1) {
1669	$subdirs[-1]{Where} = 'dirBuff';
1670	$subdirs[-1]{Offset} = length($dirBuff) + 8;
1671	}
1672	# set new format to int32u for IFD
1673	$newFormName = $$newInfo{FixFormat} \|\| 'int32u';
1674	$newFormat = $formatNumber{$newFormName};
1675	$newValuePt = \$newValue;
1676
1677	} elsif ((not defined $$subdir{Start} or
1678	$$subdir{Start} =~ /\$valuePtr/) and
1679	$$subdir{TagTable})
1680	{
1681	#
1682	# rewrite other existing subdirectories ('$valuePtr' type only)
1683	#
1684	# set subdirectory Start and Base
1685	my $subdirStart = $valuePtr;
1686	if ($$subdir{Start}) {
1687	#### eval Start ($valuePtr)
1688	$subdirStart = eval $$subdir{Start};
1689	# must adjust directory size if start changed
1690	$oldSize -= $subdirStart - $valuePtr;
1691	}
1692	my $subdirBase = $base;
1693	if ($$subdir{Base}) {
1694	my $start = $subdirStart + $valueDataPos;
1695	#### eval Base ($start,$base)
1696	$subdirBase += eval $$subdir{Base};
1697	}
1698	my $subFixup = new Image::ExifTool::Fixup;
1699	my %subdirInfo = (
1700	Base => $subdirBase,
1701	DataPt => $valueDataPt,
1702	DataPos => $valueDataPos - $subdirBase + $base,
1703	DataLen => $valueDataLen,
1704	DirStart => $subdirStart,
1705	DirName => $$subdir{DirName},
1706	DirLen => $oldSize,
1707	Parent => $dirName,
1708	Fixup => $subFixup,
1709	RAF => $raf,
1710	TagInfo => $newInfo,
1711	);
1712	unless ($oldSize) {
1713	# replace with dummy data if empty to prevent WriteDirectory
1714	# routines from accessing data they shouldn't
1715	my $tmp = '';
1716	$subdirInfo{DataPt} = \$tmp;
1717	$subdirInfo{DataLen} = 0;
1718	$subdirInfo{DirStart} = 0;
1719	$subdirInfo{DataPos} += $subdirStart;
1720	}
1721	my $subTable = Image::ExifTool::GetTagTable($$subdir{TagTable});
1722	my $oldOrder = GetByteOrder();
1723	SetByteOrder($$subdir{ByteOrder}) if $$subdir{ByteOrder};
1724	$newValue = $et->WriteDirectory(\%subdirInfo, $subTable, $$subdir{WriteProc});
1725	SetByteOrder($oldOrder);
1726	if (defined $newValue) {
1727	my $hdrLen = $subdirStart - $valuePtr;
1728	if ($hdrLen) {
1729	$newValue = substr($$valueDataPt, $valuePtr, $hdrLen) . $newValue;
1730	$$subFixup{Start} += $hdrLen;
1731	}
1732	$newValuePt = \$newValue;
1733	} else {
1734	$newValuePt = \$oldValue;
1735	}
1736	unless (length $$newValuePt) {
1737	# don't delete a previously empty makernote directory
1738	next if $oldSize or not $inMakerNotes;
1739	}
1740	if ($$subFixup{Pointers} and $subdirInfo{Base} == $base) {
1741	$$subFixup{Start} += length $valBuff;
1742	push @valFixups, $subFixup;
1743	} else {
1744	# apply fixup in case we added a header ($hdrLen above)
1745	$subFixup->ApplyFixup(\$newValue);
1746	}
1747	}
1748
1749	} elsif ($$newInfo{OffsetPair}) {
1750	#
1751	# keep track of offsets
1752	#
1753	my $dataTag = $$newInfo{DataTag} \|\| '';
1754	if ($dataTag eq 'CanonVRD') {
1755	# must decide now if we will write CanonVRD information
1756	my $hasVRD;
1757	if ($$et{NEW_VALUE}{$Image::ExifTool::Extra{CanonVRD}}) {
1758	# adding or deleting as a block
1759	$hasVRD = $et->GetNewValue('CanonVRD') ? 1 : 0;
1760	} elsif ($$et{DEL_GROUP}{CanonVRD} or
1761	$$et{DEL_GROUP}{Trailer})
1762	{
1763	$hasVRD = 0; # deleting as a group
1764	} else {
1765	$hasVRD = ($$newValuePt ne "\0\0\0\0");
1766	}
1767	if ($hasVRD) {
1768	# add a fixup, and set this offset later
1769	$dirFixup->AddFixup(length($dirBuff) + 8, $dataTag);
1770	} else {
1771	# there is (or will soon be) no VRD information, so set pointer to zero
1772	$newValue = "\0" x length($$newValuePt);
1773	$newValuePt = \$newValue;
1774	}
1775	} elsif ($dataTag eq 'OriginalDecisionData') {
1776	# handle Canon OriginalDecisionData (no associated length tag)
1777	# - I'm going out of my way here to preserve data which is
1778	# invalidated anyway by our edits
1779	my $odd;
1780	my $oddInfo = Image::ExifTool::GetCompositeTagInfo('OriginalDecisionData');
1781	if ($oddInfo and $$et{NEW_VALUE}{$oddInfo}) {
1782	$odd = $et->GetNewValue($dataTag);
1783	if ($verbose > 1) {
1784	print $out " - $dirName:$dataTag\n" if $$newValuePt ne "\0\0\0\0";
1785	print $out " + $dirName:$dataTag\n" if $odd;
1786	}
1787	++$$et{CHANGED};
1788	} elsif ($$newValuePt ne "\0\0\0\0") {
1789	if (length($$newValuePt) == 4) {
1790	require Image::ExifTool::Canon;
1791	my $offset = Get32u($newValuePt,0);
1792	# absolute offset in JPEG images only
1793	$offset += $base unless $$et{FILE_TYPE} eq 'JPEG';
1794	$odd = Image::ExifTool::Canon::ReadODD($et, $offset);
1795	$odd = $$odd if ref $odd;
1796	} else {
1797	$et->Error("Invalid $$newInfo{Name}",1);
1798	}
1799	}
1800	if ($odd) {
1801	my $newOffset = length($valBuff);
1802	# (ODD offset is absolute in JPEG, so add base offset!)
1803	$newOffset += $base if $$et{FILE_TYPE} eq 'JPEG';
1804	$newValue = Set32u($newOffset);
1805	$dirFixup->AddFixup(length($dirBuff) + 8, $dataTag);
1806	$valBuff .= $odd; # add original decision data
1807	} else {
1808	$newValue = "\0\0\0\0";
1809	}
1810	$newValuePt = \$newValue;
1811	} else {
1812	my $offsetInfo = $offsetInfo[$ifd];
1813	# save original values (for updating TIFF_END later)
1814	my @vals;
1815	if ($isNew <= 0) {
1816	my $oldOrder = GetByteOrder();
1817	# Minolta A200 stores these in the wrong byte order!
1818	SetByteOrder($$newInfo{ByteOrder}) if $$newInfo{ByteOrder};
1819	@vals = ReadValue(\$oldValue, 0, $readFormName, $readCount, $oldSize);
1820	SetByteOrder($oldOrder);
1821	$validateInfo{$newID} = [$newInfo, join(' ',@vals)] unless $$newInfo{IsOffset};
1822	}
1823	# only support int32 pointers (for now)
1824	if ($formatSize[$newFormat] != 4 and $$newInfo{IsOffset}) {
1825	$isNew > 0 and warn("Internal error (Offset not int32)"), return undef;
1826	$newCount != $readCount and warn("Wrong count!"), return undef;
1827	# change to int32
1828	$newFormName = 'int32u';
1829	$newFormat = $formatNumber{$newFormName};
1830	$newValue = WriteValue(join(' ',@vals), $newFormName, $newCount);
1831	unless (defined $newValue) {
1832	warn "Internal error writing offsets for $$newInfo{Name}\n";
1833	return undef;
1834	}
1835	$newValuePt = \$newValue;
1836	}
1837	$offsetInfo or $offsetInfo = $offsetInfo[$ifd] = { };
1838	# save location of valuePtr in new directory
1839	# (notice we add 10 instead of 8 for valuePtr because
1840	# we will put a 2-byte count at start of directory later)
1841	my $ptr = $newStart + length($dirBuff) + 10;
1842	$newCount or $newCount = 1; # make sure count is set for offsetInfo
1843	# save value pointer and value count for each tag
1844	$$offsetInfo{$newID} = [$newInfo, $ptr, $newCount, \@vals, $newFormat];
1845	}
1846
1847	} elsif ($$newInfo{DataMember}) {
1848
1849	# save any necessary data members (Make, Model, etc)
1850	my $formatStr = $newFormName;
1851	my $count = $newCount;
1852	# change to specified format if necessary
1853	if ($$newInfo{Format} and $$newInfo{Format} ne $formatStr) {
1854	$formatStr = $$newInfo{Format};
1855	my $format = $formatNumber{$formatStr};
1856	# adjust number of items for new format size
1857	$count = int(length($$newValuePt) / $formatSize[$format]) if $format;
1858	}
1859	my $val = ReadValue($newValuePt,0,$formatStr,$count,length($$newValuePt));
1860	my $conv = $$newInfo{RawConv};
1861	if ($conv) {
1862	# let the RawConv store the (possibly converted) data member
1863	if (ref $conv eq 'CODE') {
1864	&$conv($val, $et);
1865	} else {
1866	my ($priority, @grps);
1867	my ($self, $tag, $tagInfo) = ($et, $$newInfo{Name}, $newInfo);
1868	#### eval RawConv ($self, $val, $tag, $tagInfo, $priority, @grps)
1869	eval $conv;
1870	}
1871	} else {
1872	$$et{$$newInfo{DataMember}} = $val;
1873	}
1874	}
1875	}
1876	#
1877	# write out the directory entry
1878	#
1879	my $newSize = length($$newValuePt);
1880	my $fsize = $formatSize[$newFormat];
1881	my $offsetVal;
1882	# set proper count
1883	$newCount = int(($newSize + $fsize - 1) / $fsize) unless $oldInfo and $$oldInfo{FixedSize};
1884	if ($saveForValidate{$newID} and $tagTablePtr eq \%Image::ExifTool::Exif::Main) {
1885	my @vals = ReadValue(\$newValue, 0, $newFormName, $newCount, $newSize);
1886	$validateInfo{$newID} = join ' ',@vals;
1887	}
1888	if ($newSize > 4) {
1889	# zero-pad to an even number of bytes (required by EXIF standard)
1890	# and make sure we are a multiple of the format size
1891	while ($newSize & 0x01 or $newSize < $newCount * $fsize) {
1892	$$newValuePt .= "\0";
1893	++$newSize;
1894	}
1895	my $entryBased;
1896	if ($$dirInfo{EntryBased} or ($newInfo and $$newInfo{EntryBased})) {
1897	$entryBased = 1;
1898	$offsetVal = Set32u(length($valBuff) - length($dirBuff));
1899	} else {
1900	$offsetVal = Set32u(length $valBuff);
1901	}
1902	my ($dataTag, $putFirst);
1903	($dataTag, $putFirst) = @$newInfo{'DataTag','PutFirst'} if $newInfo;
1904	if ($dataTag) {
1905	if ($dataTag eq 'PreviewImage' and ($$et{FILE_TYPE} eq 'JPEG' or
1906	$$et{GENERATE_PREVIEW_INFO}))
1907	{
1908	# hold onto the PreviewImage until we can determine if it fits
1909	$$et{PREVIEW_INFO} or $$et{PREVIEW_INFO} = {
1910	Data => $$newValuePt,
1911	Fixup => new Image::ExifTool::Fixup,
1912	};
1913	$$et{PREVIEW_INFO}{ChangeBase} = 1 if $$newInfo{ChangeBase};
1914	if ($$newInfo{IsOffset} and $$newInfo{IsOffset} eq '2') {
1915	$$et{PREVIEW_INFO}{NoBaseShift} = 1;
1916	}
1917	# use original preview size if we will attempt to load it later
1918	$newCount = $oldCount if $$newValuePt eq 'LOAD_PREVIEW';
1919	$$newValuePt = '';
1920	} elsif ($dataTag eq 'LeicaTrailer' and $$et{LeicaTrailer}) {
1921	$$newValuePt = '';
1922	}
1923	}
1924	if ($putFirst and $$dirInfo{HeaderPtr}) {
1925	my $hdrPtr = $$dirInfo{HeaderPtr};
1926	# place this value immediately after the TIFF header (eg. IIQ maker notes)
1927	$offsetVal = Set32u(length $$hdrPtr);
1928	$$hdrPtr .= $$newValuePt;
1929	} else {
1930	$valBuff .= $$newValuePt; # add value data to buffer
1931	# must save a fixup pointer for every pointer in the directory
1932	if ($entryBased) {
1933	$entryBasedFixup or $entryBasedFixup = new Image::ExifTool::Fixup;
1934	$entryBasedFixup->AddFixup(length($dirBuff) + 8, $dataTag);
1935	} else {
1936	$dirFixup->AddFixup(length($dirBuff) + 8, $dataTag);
1937	}
1938	}
1939	} else {
1940	$offsetVal = $$newValuePt; # save value in offset if 4 bytes or less
1941	# must pad value with zeros if less than 4 bytes
1942	$newSize < 4 and $offsetVal .= "\0" x (4 - $newSize);
1943	}
1944	# write the directory entry
1945	$dirBuff .= Set16u($newID) . Set16u($newFormat) .
1946	Set32u($newCount) . $offsetVal;
1947	# update flag to keep track of mandatory tags
1948	while (defined $allMandatory) {
1949	if (defined $$mandatory{$newID}) {
1950	# values must correspond to mandatory values
1951	my $form = $$newInfo{Format} \|\| $newFormName;
1952	my $mandVal = WriteValue($$mandatory{$newID}, $form, $newCount);
1953	if (defined $mandVal and $mandVal eq $$newValuePt) {
1954	++$allMandatory; # count mandatory tags
1955	last;
1956	}
1957	}
1958	undef $deleteAll;
1959	undef $allMandatory;
1960	}
1961	}
1962	if (%validateInfo) {
1963	ValidateImageData($et, \%validateInfo, $dirName, 1);
1964	undef %validateInfo;
1965	}
1966	if ($ignoreCount) {
1967	my $y = $ignoreCount > 1 ? 'ies' : 'y';
1968	my $verb = $$dirInfo{FixBase} ? 'Ignored' : 'Removed';
1969	$et->Warn("$verb $ignoreCount invalid entr$y from $name", 1);
1970	}
1971	if ($fixCount) {
1972	my $s = $fixCount > 1 ? 's' : '';
1973	$et->Warn("Fixed invalid count$s for $fixCount $name tag$s", 1);
1974	}
1975	#..............................................................................
1976	# write directory counts and nextIFD pointer and add value data to end of IFD
1977	#
1978	# determine now if there is or will be another IFD after this one
1979	my $nextIfdOffset;
1980	if ($dirEnd + 4 <= $dataLen) {
1981	$nextIfdOffset = Get32u($dataPt, $dirEnd);
1982	} else {
1983	$nextIfdOffset = 0;
1984	}
1985	my $isNextIFD = ($$dirInfo{Multi} and ($nextIfdOffset or
1986	# account for the case where we will create the next IFD
1987	# (IFD1 only, but not in TIFF-format images)
1988	($dirName eq 'IFD0' and $$et{ADD_DIRS}{'IFD1'} and
1989	$$et{FILE_TYPE} ne 'TIFF')));
1990	# calculate number of entries in new directory
1991	my $newEntries = length($dirBuff) / 12;
1992	# delete entire directory if we deleted a tag and only mandatory tags remain or we
1993	# attempted to create a directory with only mandatory tags and there is no nextIFD
1994	if ($allMandatory and not $isNextIFD and ($newEntries < $numEntries or $numEntries == 0)) {
1995	$newEntries = 0;
1996	$dirBuff = '';
1997	$valBuff = '';
1998	undef $dirFixup; # no fixups in this directory
1999	++$deleteAll if defined $deleteAll;
2000	$verbose > 1 and print $out " - $allMandatory mandatory tag(s)\n";
2001	$$et{CHANGED} -= $addMandatory; # didn't change these after all
2002	}
2003	if ($ifd and not $newEntries) {
2004	$verbose and print $out " Deleting IFD1\n";
2005	last; # don't write IFD1 if empty
2006	}
2007	# apply one-time fixup for entry-based offsets
2008	if ($entryBasedFixup) {
2009	$$entryBasedFixup{Shift} = length($dirBuff) + 4;
2010	$entryBasedFixup->ApplyFixup(\$dirBuff);
2011	undef $entryBasedFixup;
2012	}
2013	# initialize next IFD pointer to zero
2014	my $nextIFD = Set32u(0);
2015	# some cameras use a different amount of padding after the makernote IFD
2016	if ($dirName eq 'MakerNotes' and $$dirInfo{Parent} =~ /^(ExifIFD\|IFD0)$/) {
2017	my ($rel, $pad) = Image::ExifTool::MakerNotes::GetMakerNoteOffset($et);
2018	$nextIFD = "\0" x $pad if defined $pad and ($pad==0 or ($pad>4 and $pad<=32));
2019	}
2020	# add directory entry count to start of IFD and next IFD pointer to end
2021	$newData .= Set16u($newEntries) . $dirBuff . $nextIFD;
2022	# get position of value data in newData
2023	my $valPos = length($newData);
2024	# go back now and set next IFD pointer if this isn't the first IFD
2025	if ($nextIfdPos) {
2026	# set offset to next IFD
2027	Set32u($newStart, \$newData, $nextIfdPos);
2028	$fixup->AddFixup($nextIfdPos,'NextIFD'); # add fixup for this offset in newData
2029	}
2030	# remember position of 'next IFD' pointer so we can set it next time around
2031	$nextIfdPos = length($nextIFD) ? $valPos - length($nextIFD) : undef;
2032	# add value data after IFD
2033	$newData .= $valBuff;
2034	#
2035	# add any subdirectories, adding fixup information
2036	#
2037	if (@subdirs) {
2038	my $subdir;
2039	foreach $subdir (@subdirs) {
2040	my $len = length($newData); # position of subdirectory in data
2041	my $subdirFixup = $$subdir{Fixup};
2042	if ($subdirFixup) {
2043	$$subdirFixup{Start} += $len;
2044	$fixup->AddFixup($subdirFixup);
2045	}
2046	my $imageData = $$subdir{ImageData};
2047	my $blockSize = 0;
2048	# must also update start position for ImageData fixups
2049	if (ref $imageData) {
2050	my $blockInfo;
2051	foreach $blockInfo (@$imageData) {
2052	my ($pos, $size, $pad, $entry, $subFix) = @$blockInfo;
2053	if ($subFix) {
2054	$$subFix{Start} += $len;
2055	# save expected image data offset for calculating shift later
2056	$$subFix{BlockLen} = length(${$$subdir{DataPt}}) + $blockSize;
2057	}
2058	$blockSize += $size + $pad;
2059	}
2060	}
2061	$newData .= ${$$subdir{DataPt}}; # add subdirectory to our data
2062	undef ${$$subdir{DataPt}}; # free memory now
2063	# set the pointer
2064	my $offset = $$subdir{Offset};
2065	# if offset is in valBuff, it was added to the end of dirBuff
2066	# (plus 4 bytes for nextIFD pointer)
2067	$offset += length($dirBuff) + 4 if $$subdir{Where} eq 'valBuff';
2068	$offset += $newStart + 2; # get offset in newData
2069	# check to be sure we got the right offset
2070	unless (Get32u(\$newData, $offset) == 0xfeedf00d) {
2071	$et->Error("Internal error while rewriting $name");
2072	return undef;
2073	}
2074	# set the offset to the subdirectory data
2075	Set32u($len, \$newData, $offset);
2076	$fixup->AddFixup($offset); # add fixup for this offset in newData
2077	}
2078	}
2079	# add fixup for all offsets in directory according to value data position
2080	# (which is at the end of this directory)
2081	if ($dirFixup) {
2082	$$dirFixup{Start} = $newStart + 2;
2083	$$dirFixup{Shift} = $valPos - $$dirFixup{Start};
2084	$fixup->AddFixup($dirFixup);
2085	}
2086	# add valueData fixups, adjusting for position of value data
2087	my $valFixup;
2088	foreach $valFixup (@valFixups) {
2089	$$valFixup{Start} += $valPos;
2090	$fixup->AddFixup($valFixup);
2091	}
2092	# stop if no next IFD pointer
2093	last unless $isNextIFD; # stop unless scanning for multiple IFD's
2094	if ($nextIfdOffset) {
2095	# continue with next IFD
2096	$dirStart = $nextIfdOffset - $dataPos;
2097	} else {
2098	# create IFD1 if necessary
2099	$verbose and print $out " Creating IFD1\n";
2100	my $ifd1 = "\0" x 2; # empty IFD1 data (zero entry count)
2101	$dataPt = \$ifd1;
2102	$dirStart = 0;
2103	$dirLen = $dataLen = 2;
2104	}
2105	# increment IFD name
2106	my $ifdNum = $dirName =~ s/(\d+)$// ? $1 : 0;
2107	$dirName .= $ifdNum + 1;
2108	$name =~ s/\d+$//;
2109	$name .= $ifdNum + 1;
2110	$$et{DIR_NAME} = $$et{PATH}[-1] = $dirName;
2111	next unless $nextIfdOffset;
2112
2113	# guard against writing the same directory twice
2114	my $addr = $nextIfdOffset + $base;
2115	if ($$et{PROCESSED}{$addr}) {
2116	$et->Error("$name pointer references previous $$et{PROCESSED}{$addr} directory", 1);
2117	last;
2118	}
2119	$$et{PROCESSED}{$addr} = $name;
2120
2121	if ($dirName eq 'SubIFD1' and not ValidateIFD($dirInfo, $dirStart)) {
2122	if ($$et{TIFF_TYPE} eq 'TIFF') {
2123	$et->Error('Ignored bad IFD linked from SubIFD', 1);
2124	} elsif ($verbose) {
2125	$et->Warn('Ignored bad IFD linked from SubIFD');
2126	}
2127	last; # don't write bad IFD
2128	}
2129	if ($$et{DEL_GROUP}{$dirName}) {
2130	$verbose and print $out " Deleting $dirName\n";
2131	$raf and $et->Error("Deleting $dirName also deletes subsequent" .
2132	" IFD's and possibly image data", 1);
2133	++$$et{CHANGED};
2134	if ($$et{DEL_GROUP}{$dirName} == 2 and
2135	$$et{ADD_DIRS}{$dirName})
2136	{
2137	my $emptyIFD = "\0" x 2; # start with empty IFD
2138	$dataPt = \$emptyIFD;
2139	$dirStart = 0;
2140	$dirLen = $dataLen = 2;
2141	} else {
2142	last; # don't write this IFD (or any subsequent IFD)
2143	}
2144	} else {
2145	$verbose and print $out " Rewriting $name\n";
2146	}
2147	}
2148	#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
2149
2150	# do our fixups now so we can more easily calculate offsets below
2151	$fixup->ApplyFixup(\$newData);
2152	#
2153	# determine total block size for deferred data
2154	#
2155	my $numBlocks = scalar @imageData; # save this so we scan only existing blocks later
2156	my $blockSize = 0; # total size of blocks to copy later
2157	my $blockInfo;
2158	foreach $blockInfo (@imageData) {
2159	my ($pos, $size, $pad) = @$blockInfo;
2160	$blockSize += $size + $pad;
2161	}
2162	#
2163	# copy over image data for IFD's, starting with the last IFD first
2164	#
2165	if (@offsetInfo) {
2166	my $ttwLen; # length of MRW TTW segment
2167	my @writeLater; # write image data last
2168	for ($ifd=$#offsetInfo; $ifd>=-1; --$ifd) {
2169	# build list of offsets to process
2170	my @offsetList;
2171	if ($ifd >= 0) {
2172	my $offsetInfo = $offsetInfo[$ifd] or next;
2173	# patch Panasonic RAW/RW2 StripOffsets/StripByteCounts if necessary
2174	my $stripOffsets = $$offsetInfo{0x111};
2175	if ($stripOffsets and $$stripOffsets[0]{PanasonicHack}) {
2176	require Image::ExifTool::PanasonicRaw;
2177	my $err = Image::ExifTool::PanasonicRaw::PatchRawDataOffset($offsetInfo, $raf, $ifd);
2178	$err and $et->Error($err);
2179	}
2180	my $tagID;
2181	# loop through all tags in reverse order so we save thumbnail
2182	# data before main image data if both exist in the same IFD
2183	foreach $tagID (reverse sort keys %$offsetInfo) {
2184	my $tagInfo = $$offsetInfo{$tagID}[0];
2185	next unless $$tagInfo{IsOffset}; # handle byte counts with offsets
2186	my $sizeInfo = $$offsetInfo{$$tagInfo{OffsetPair}};
2187	$sizeInfo or $et->Error("No size tag for $dirName:$$tagInfo{Name}"), next;
2188	my $dataTag = $$tagInfo{DataTag};
2189	# write TIFF image data (strips or tiles) later if requested
2190	if ($raf and defined $$origDirInfo{ImageData} and
2191	($tagID == 0x111 or $tagID == 0x144 or
2192	# also defer writing of other big data such as JpgFromRaw in NEF
2193	($$sizeInfo[3][0] and
2194	# (calculate approximate combined size of all blocks)
2195	$$sizeInfo[3][0] * scalar(@{$$sizeInfo[3]}) > 1000000)) and
2196	# but don't defer writing if replacing with new value
2197	(not defined $dataTag or not defined $offsetData{$dataTag}))
2198	{
2199	push @writeLater, [ $$offsetInfo{$tagID}, $sizeInfo ];
2200	} else {
2201	push @offsetList, [ $$offsetInfo{$tagID}, $sizeInfo ];
2202	}
2203	}
2204	} else {
2205	last unless @writeLater;
2206	@offsetList = @writeLater;
2207	}
2208	my $offsetPair;
2209	foreach $offsetPair (@offsetList) {
2210	my ($tagInfo, $offsets, $count, $oldOffset) = @{$$offsetPair[0]};
2211	my ($cntInfo, $byteCounts, $count2, $oldSize, $format) = @{$$offsetPair[1]};
2212	# must be the same number of offset and byte count values
2213	unless ($count == $count2) {
2214	$et->Error("Offsets/ByteCounts disagree on count for $$tagInfo{Name}");
2215	return undef;
2216	}
2217	my $formatStr = $formatName[$format];
2218	# follow pointer to value data if necessary
2219	$count > 1 and $offsets = Get32u(\$newData, $offsets);
2220	my $n = $count * $formatSize[$format];
2221	$n > 4 and $byteCounts = Get32u(\$newData, $byteCounts);
2222	if ($byteCounts < 0 or $byteCounts + $n > length($newData)) {
2223	$et->Error("Error reading $$tagInfo{Name} byte counts");
2224	return undef;
2225	}
2226	# get offset base and data pos (abnormal for some preview images)
2227	my ($dbase, $dpos, $wrongBase, $subIfdDataFixup);
2228	if ($$tagInfo{IsOffset} eq '2') {
2229	$dbase = $firstBase;
2230	$dpos = $dataPos + $base - $firstBase;
2231	} else {
2232	$dbase = $base;
2233	$dpos = $dataPos;
2234	}
2235	# use different base if necessary for some offsets (Minolta A200)
2236	if ($$tagInfo{WrongBase}) {
2237	my $self = $et;
2238	#### eval WrongBase ($self)
2239	$wrongBase = eval $$tagInfo{WrongBase} \|\| 0;
2240	$dbase += $wrongBase;
2241	$dpos -= $wrongBase;
2242	} else {
2243	$wrongBase = 0;
2244	}
2245	my $oldOrder = GetByteOrder();
2246	my $dataTag = $$tagInfo{DataTag};
2247	# use different byte order for values of this offset pair if required (Minolta A200)
2248	SetByteOrder($$tagInfo{ByteOrder}) if $$tagInfo{ByteOrder};
2249	# transfer the data referenced by all offsets of this tag
2250	for ($n=0; $n<$count; ++$n) {
2251	my ($oldEnd, $size);
2252	if (@$oldOffset and @$oldSize) {
2253	# calculate end offset of this block
2254	$oldEnd = $$oldOffset[$n] + $$oldSize[$n];
2255	# update TIFF_END as if we read this data from file
2256	UpdateTiffEnd($et, $oldEnd + $dbase);
2257	}
2258	my $offsetPos = $offsets + $n * 4;
2259	my $byteCountPos = $byteCounts + $n * $formatSize[$format];
2260	if ($$tagInfo{PanasonicHack}) {
2261	# use actual raw data length (may be different than StripByteCounts!)
2262	$size = $$oldSize[$n];
2263	} else {
2264	# use size of new data
2265	$size = ReadValue(\$newData, $byteCountPos, $formatStr, 1, 4);
2266	}
2267	my $offset = $$oldOffset[$n];
2268	if (defined $offset) {
2269	$offset -= $dpos;
2270	} elsif ($size != 0xfeedfeed) {
2271	$et->Error('Internal error (no offset)');
2272	return undef;
2273	}
2274	my $newOffset = length($newData) - $wrongBase;
2275	my $buff;
2276	# look for 'feed' code to use our new data
2277	if ($size == 0xfeedfeed) {
2278	unless (defined $dataTag) {
2279	$et->Error("No DataTag defined for $$tagInfo{Name}");
2280	return undef;
2281	}
2282	unless (defined $offsetData{$dataTag}) {
2283	$et->Error("Internal error (no $dataTag)");
2284	return undef;
2285	}
2286	if ($count > 1) {
2287	$et->Error("Can't modify $$tagInfo{Name} with count $count");
2288	return undef;
2289	}
2290	$buff = $offsetData{$dataTag};
2291	if ($formatSize[$format] != 4) {
2292	$et->Error("$$cntInfo{Name} is not int32");
2293	return undef;
2294	}
2295	# set the data size
2296	$size = length($buff);
2297	Set32u($size, \$newData, $byteCountPos);
2298	} elsif ($ifd < 0) {
2299	# pad if necessary (but don't pad contiguous image blocks)
2300	my $pad = 0;
2301	++$pad if ($blockSize + $size) & 0x01 and ($n+1 >= $count or
2302	not $oldEnd or $oldEnd != $$oldOffset[$n+1]);
2303	# preserve original image padding if specified
2304	if ($$origDirInfo{PreserveImagePadding} and $n+1 < $count and
2305	$oldEnd and $$oldOffset[$n+1] > $oldEnd)
2306	{
2307	$pad = $$oldOffset[$n+1] - $oldEnd;
2308	}
2309	# copy data later
2310	push @imageData, [$offset+$dbase+$dpos, $size, $pad];
2311	$newOffset += $blockSize; # data comes after other deferred data
2312	# create fixup for SubIFD ImageData
2313	if ($imageDataFlag eq 'SubIFD' and not $subIfdDataFixup) {
2314	$subIfdDataFixup = new Image::ExifTool::Fixup;
2315	$imageData[-1][4] = $subIfdDataFixup;
2316	}
2317	$size += $pad; # account for pad byte if necessary
2318	# return ImageData list
2319	$$origDirInfo{ImageData} = \@imageData;
2320	} elsif ($offset >= 0 and $offset+$size <= $dataLen) {
2321	# take data from old dir data buffer
2322	$buff = substr($$dataPt, $offset, $size);
2323	} elsif ($$et{TIFF_TYPE} eq 'MRW') {
2324	# TTW segment must be an even 4 bytes long, so pad now if necessary
2325	my $n = length $newData;
2326	$buff = ($n & 0x03) ? "\0" x (4 - ($n & 0x03)) : '';
2327	$size = length($buff);
2328	# data exists after MRW TTW segment
2329	$ttwLen = length($newData) + $size unless defined $ttwLen;
2330	$newOffset = $offset + $dpos + $ttwLen - $dataLen;
2331	} elsif ($raf and $raf->Seek($offset+$dbase+$dpos,0) and
2332	$raf->Read($buff,$size) == $size)
2333	{
2334	# (data was read OK)
2335	# patch incorrect ThumbnailOffset in Sony A100 1.00 ARW images
2336	if ($$et{TIFF_TYPE} eq 'ARW' and $$tagInfo{Name} eq 'ThumbnailOffset' and
2337	$$et{Model} eq 'DSLR-A100' and $buff !~ /^\xff\xd8\xff/)
2338	{
2339	my $pos = $offset + $dbase + $dpos;
2340	my $try;
2341	if ($pos < 0x10000 and $raf->Seek($pos+0x10000,0) and
2342	$raf->Read($try,$size) == $size and $try =~ /^\xff\xd8\xff/)
2343	{
2344	$buff = $try;
2345	$et->Warn('Adjusted incorrect A100 ThumbnailOffset', 1);
2346	} else {
2347	$et->Error('Invalid ThumbnailImage');
2348	}
2349	}
2350	} elsif ($$tagInfo{Name} eq 'ThumbnailOffset' and $offset>=0 and $offset<$dataLen) {
2351	# Grrr. The Canon 350D writes the thumbnail with an incorrect byte count
2352	my $diff = $offset + $size - $dataLen;
2353	$et->Warn("ThumbnailImage runs outside EXIF data by $diff bytes (truncated)",1);
2354	# set the size to the available data
2355	$size -= $diff;
2356	unless (WriteValue($size, $formatStr, 1, \$newData, $byteCountPos)) {
2357	warn 'Internal error writing thumbnail size';
2358	}
2359	# get the truncated image
2360	$buff = substr($$dataPt, $offset, $size);
2361	} elsif ($$tagInfo{Name} eq 'PreviewImageStart' and $$et{FILE_TYPE} eq 'JPEG') {
2362	# try to load the preview image using the specified offset
2363	undef $buff;
2364	my $r = $$et{RAF};
2365	if ($r and not $raf) {
2366	my $tell = $r->Tell();
2367	# read and validate
2368	undef $buff unless $r->Seek($offset+$base+$dataPos,0) and
2369	$r->Read($buff,$size) == $size and
2370	$buff =~ /^.\xd8\xff[\xc4\xdb\xe0-\xef]/s;
2371	$r->Seek($tell, 0) or $et->Error('Seek error'), return undef;
2372	}
2373	# set flag if we must load PreviewImage
2374	$buff = 'LOAD_PREVIEW' unless defined $buff;
2375	} else {
2376	my $dataName = $dataTag \|\| $$tagInfo{Name};
2377	return undef if $et->Error("Error reading $dataName data in $name", $inMakerNotes);
2378	$buff = '';
2379	}
2380	if ($$tagInfo{Name} eq 'PreviewImageStart') {
2381	if ($$et{FILE_TYPE} eq 'JPEG' and not $$tagInfo{MakerPreview}) {
2382	# hold onto the PreviewImage until we can determine if it fits
2383	$$et{PREVIEW_INFO} or $$et{PREVIEW_INFO} = {
2384	Data => $buff,
2385	Fixup => new Image::ExifTool::Fixup,
2386	};
2387	if ($$tagInfo{IsOffset} and $$tagInfo{IsOffset} eq '2') {
2388	$$et{PREVIEW_INFO}{NoBaseShift} = 1;
2389	}
2390	if ($offset >= 0 and $offset+$size <= $dataLen) {
2391	# set flag indicating this preview wasn't in a trailer
2392	$$et{PREVIEW_INFO}{WasContained} = 1;
2393	}
2394	$buff = '';
2395	} elsif ($$et{TIFF_TYPE} eq 'ARW' and $$et{Model} eq 'DSLR-A100') {
2396	# the A100 double-references the same preview, so ignore the
2397	# second one (the offset and size will be patched later)
2398	next if $$et{A100PreviewLength};
2399	$$et{A100PreviewLength} = length $buff if defined $buff;
2400	}
2401	}
2402	# update offset accordingly and add to end of new data
2403	Set32u($newOffset, \$newData, $offsetPos);
2404	# add a pointer to fix up this offset value (marked with DataTag name)
2405	$fixup->AddFixup($offsetPos, $dataTag);
2406	# also add to subIfdDataFixup if necessary
2407	$subIfdDataFixup->AddFixup($offsetPos, $dataTag) if $subIfdDataFixup;
2408	# must also (sometimes) update StripOffsets in Panasonic RW2 images
2409	my $otherPos = $$offsetPair[0][5];
2410	if ($otherPos and $$tagInfo{PanasonicHack}) {
2411	Set32u($newOffset, \$newData, $otherPos);
2412	$fixup->AddFixup($otherPos, $dataTag);
2413	}
2414	if ($ifd >= 0) {
2415	# buff length must be even (Note: may have changed since $size was set)
2416	$buff .= "\0" if length($buff) & 0x01;
2417	$newData .= $buff; # add this strip to the data
2418	} else {
2419	$blockSize += $size; # keep track of total size
2420	}
2421	}
2422	SetByteOrder($oldOrder);
2423	}
2424	}
2425	# verify that nothing else got written after determining TTW length
2426	if (defined $ttwLen and $ttwLen != length($newData)) {
2427	$et->Error('Internal error writing MRW TTW');
2428	}
2429	}
2430	#
2431	# set offsets and generate fixups for tag values which were too large for memory
2432	#
2433	$blockSize = 0;
2434	foreach $blockInfo (@imageData) {
2435	my ($pos, $size, $pad, $entry, $subFix) = @$blockInfo;
2436	if (defined $entry) {
2437	my $format = Get16u(\$newData, $entry + 2);
2438	if ($format < 1 or $format > 13) {
2439	$et->Error('Internal error copying huge value');
2440	last;
2441	} else {
2442	# set count and offset in directory entry
2443	Set32u($size / $formatSize[$format], \$newData, $entry + 4);
2444	Set32u(length($newData)+$blockSize, \$newData, $entry + 8);
2445	$fixup->AddFixup($entry + 8);
2446	# create special fixup for SubIFD data
2447	if ($imageDataFlag eq 'SubIFD') {
2448	my $subIfdDataFixup = new Image::ExifTool::Fixup;
2449	$subIfdDataFixup->AddFixup($entry + 8);
2450	# save fixup in imageData list
2451	$$blockInfo[4] = $subIfdDataFixup;
2452	}
2453	# must reset entry pointer so we don't use it again in a parent IFD!
2454	$$blockInfo[3] = undef;
2455	}
2456	}
2457	# apply additional shift required for contained SubIFD image data offsets
2458	if ($subFix and defined $$subFix{BlockLen} and $numBlocks > 0) {
2459	# our offset expects the data at the end of the SubIFD block (BlockLen + Start),
2460	# but it will actually be at length($newData) + $blockSize. So adjust
2461	# accordingly (and subtract an extra Start because this shift is applied later)
2462	$$subFix{Shift} += length($newData) - $$subFix{BlockLen} - 2 * $$subFix{Start} + $blockSize;
2463	$subFix->ApplyFixup(\$newData);
2464	}
2465	$blockSize += $size + $pad;
2466	--$numBlocks;
2467	}
2468	#
2469	# apply final shift to new data position if this is the top level IFD
2470	#
2471	unless ($$dirInfo{Fixup}) {
2472	my $hdrPtr = $$dirInfo{HeaderPtr};
2473	my $newDataPos = $hdrPtr ? length $$hdrPtr : $$dirInfo{NewDataPos} \|\| 0;
2474	# adjust CanonVRD offset to point to end of regular TIFF if necessary
2475	# (NOTE: This will be incorrect if multiple trailers exist,
2476	# but it is unlikely that it could ever be correct in this case anyway.
2477	# Also, this doesn't work for JPEG images (but CanonDPP doesn't set
2478	# this when editing JPEG images anyway))
2479	$fixup->SetMarkerPointers(\$newData, 'CanonVRD', length($newData) + $blockSize);
2480	if ($newDataPos) {
2481	$$fixup{Shift} += $newDataPos;
2482	$fixup->ApplyFixup(\$newData);
2483	}
2484	# save fixup for adjusting Leica trailer offset if necessary
2485	$$et{LeicaTrailer}{Fixup}->AddFixup($fixup) if $$et{LeicaTrailer};
2486	# save fixup for PreviewImage in JPEG file if necessary
2487	my $previewInfo = $$et{PREVIEW_INFO};
2488	if ($previewInfo) {
2489	my $pt = \$$previewInfo{Data}; # image data or 'LOAD_PREVIEW' flag
2490	# now that we know the size of the EXIF data, first test to see if our new image fits
2491	# inside the EXIF segment (remember about the TIFF and EXIF headers: 8+6 bytes)
2492	if (($$pt ne 'LOAD_PREVIEW' and length($$pt) + length($newData) + 14 <= 0xfffd and
2493	not $$previewInfo{IsTrailer}) or
2494	$$previewInfo{IsShort}) # must fit in this segment if using short pointers
2495	{
2496	# It fits! (or must exist in EXIF segment), so fixup the
2497	# PreviewImage pointers and stuff the preview image in here
2498	my $newPos = length($newData) + $newDataPos;
2499	$newPos += ($$previewInfo{BaseShift} \|\| 0);
2500	if ($$previewInfo{Relative}) {
2501	# calculate our base by looking at how far the pointer got shifted
2502	$newPos -= ($fixup->GetMarkerPointers(\$newData, 'PreviewImage') \|\| 0);
2503	}
2504	$fixup->SetMarkerPointers(\$newData, 'PreviewImage', $newPos);
2505	$newData .= $$pt;
2506	# set flag to delete old preview unless it was contained in the EXIF
2507	$$et{DEL_PREVIEW} = 1 unless $$et{PREVIEW_INFO}{WasContained};
2508	delete $$et{PREVIEW_INFO}; # done with our preview data
2509	} else {
2510	# Doesn't fit, or we still don't know, so save fixup information
2511	# and put the preview at the end of the file
2512	$$previewInfo{Fixup} or $$previewInfo{Fixup} = new Image::ExifTool::Fixup;
2513	$$previewInfo{Fixup}->AddFixup($fixup);
2514	}
2515	} elsif (defined $newData and $deleteAll) {
2516	$newData = ''; # delete both IFD0 and IFD1 since only mandatory tags remain
2517	} elsif ($$et{A100PreviewLength}) {
2518	# save preview image start for patching A100 quirks later
2519	$$et{A100PreviewStart} = $fixup->GetMarkerPointers(\$newData, 'PreviewImage');
2520	}
2521	# save location of last IFD for use in Canon RAW header
2522	if ($newDataPos == 16) {
2523	my @ifdPos = $fixup->GetMarkerPointers(\$newData,'NextIFD');
2524	$$origDirInfo{LastIFD} = pop @ifdPos;
2525	}
2526	# recrypt SR2 SubIFD data if necessary
2527	my $key = $$et{SR2SubIFDKey};
2528	if ($key) {
2529	my $start = $fixup->GetMarkerPointers(\$newData, 'SR2SubIFDOffset');
2530	my $len = $$et{SR2SubIFDLength};
2531	# (must subtract 8 for size of TIFF header)
2532	if ($start and $start - 8 + $len <= length $newData) {
2533	require Image::ExifTool::Sony;
2534	Image::ExifTool::Sony::Decrypt(\$newData, $start - 8, $len, $key);
2535	}
2536	}
2537	}
2538	# return empty string if no entries in directory
2539	# (could be up to 10 bytes and still be empty)
2540	$newData = '' if defined $newData and length($newData) < 12;
2541
2542	# set changed if ForceWrite tag was set to "EXIF"
2543	++$$et{CHANGED} if defined $newData and length $newData and $$et{FORCE_WRITE}{EXIF};
2544
2545	return $newData; # return our directory data
2546	}
2547
2548	1; # end
2549
2550	__END__
2551
2552	=head1 NAME
2553
2554	Image::ExifTool::WriteExif.pl - Write EXIF meta information
2555
2556	=head1 SYNOPSIS
2557
2558	This file is autoloaded by Image::ExifTool::Exif.
2559
2560	=head1 DESCRIPTION
2561
2562	This file contains routines to write EXIF metadata.
2563
2564	=head1 AUTHOR
2565
2566	Copyright 2003-2021, Phil Harvey (philharvey66 at gmail.com)
2567
2568	This library is free software; you can redistribute it and/or modify it
2569	under the same terms as Perl itself.
2570
2571	=head1 SEE ALSO
2572
2573	L<Image::ExifTool::Exif(3pm)\|Image::ExifTool::Exif>,
2574	L<Image::ExifTool(3pm)\|Image::ExifTool>
2575
2576	=cut

Note: See TracBrowser for help on using the repository browser.

Context Navigation

source: main/trunk/greenstone2/perllib/cpan/Image/ExifTool/WriteExif.pl@ 34921

Download in other formats: