Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Blame
Revision Log

source: gsdl/trunk/perllib/cpan/Image/ExifTool.pm@ 16842

Last change on this file since 16842 was 16842, checked in by davidb, 16 years ago
ExifTool added to cpan area to support metadata extraction from files such as JPEG. Primarily targetted as Image files (hence the Image folder name decided upon by the ExifTool author) it also can handle video such as flash and audio such as Wav
File size: 159.1 KB

Line
1	#------------------------------------------------------------------------------
2	# File: ExifTool.pm
3	#
4	# Description: Read and write meta information
5	#
6	# URL: http://owl.phy.queensu.ca/~phil/exiftool/
7	#
8	# Revisions: Nov. 12/03 - P. Harvey Created
9	# (See html/history.html for revision history)
10	#
11	# Legal: Copyright (c) 2003-2007, Phil Harvey (phil at owl.phy.queensu.ca)
12	# This library is free software; you can redistribute it and/or
13	# modify it under the same terms as Perl itself.
14	#------------------------------------------------------------------------------
15
16	package Image::ExifTool;
17
18	use strict;
19	require 5.004; # require 5.004 for UNIVERSAL::isa (otherwise 5.002 would do)
20	require Exporter;
21	use File::RandomAccess;
22
23	use vars qw($VERSION $RELEASE @ISA %EXPORT_TAGS $AUTOLOAD @fileTypes %allTables
24	@tableOrder $exifAPP1hdr $xmpAPP1hdr $psAPP13hdr $psAPP13old
25	@loadAllTables %UserDefined $evalWarning);
26
27	$VERSION = '7.00';
28	$RELEASE = '';
29	@ISA = qw(Exporter);
30	%EXPORT_TAGS = (
31	# all public non-object-oriented functions
32	Public => [qw(
33	ImageInfo GetTagName GetShortcuts GetAllTags GetWritableTags
34	GetAllGroups GetDeleteGroups GetFileType CanWrite CanCreate
35	)],
36	DataAccess => [qw(
37	ReadValue GetByteOrder SetByteOrder ToggleByteOrder Get8u Get8s Get16u
38	Get16s Get32u Get32s GetFloat GetDouble GetFixed32s Write WriteValue
39	Tell Set8u Set8s Set16u Set32u
40	)],
41	Utils => [qw(
42	GetTagTable TagTableKeys GetTagInfoList GenerateTagIDs SetFileType
43	HtmlDump
44	)],
45	Vars => [qw(
46	%allTables @tableOrder @fileTypes
47	)],
48	);
49	# set all of our EXPORT_TAGS in EXPORT_OK
50	Exporter::export_ok_tags(keys %EXPORT_TAGS);
51
52	# test for problems that can arise if encoding.pm is used
53	{ my $t = "\xff"; die "Incompatible encoding!\n" if ord($t) != 0xff; }
54
55	# The following functions defined in Image::ExifTool::Writer are declared
56	# here so their prototypes will be available. The Writer routines will be
57	# autoloaded when any of these are called.
58	sub SetNewValue($;$$%);
59	sub SetNewValuesFromFile($$;@);
60	sub GetNewValues($;$$);
61	sub CountNewValues($);
62	sub SaveNewValues($);
63	sub RestoreNewValues($);
64	sub WriteInfo($$;$$);
65	sub SetFileModifyDate($$;$);
66	sub SetFileName($$;$);
67	sub GetAllTags(;$);
68	sub GetWritableTags(;$);
69	sub GetAllGroups($);
70	sub GetNewGroups($);
71	sub GetDeleteGroups();
72	# non-public routines below
73	sub InsertTagValues($$$;$);
74	sub IsWritable($);
75	sub GetNewFileName($$);
76	sub LoadAllTables();
77	sub GetNewTagInfoList($;$);
78	sub GetNewTagInfoHash($@);
79	sub GetLangInfo($$);
80	sub Get64s($$);
81	sub Get64u($$);
82	sub GetExtended($$);
83	sub DecodeBits($$;$);
84	sub EncodeBits($$;$$);
85	sub HexDump($;$%);
86	sub DumpTrailer($$);
87	sub DumpUnknownTrailer($$);
88	sub VerboseInfo($$$%);
89	sub VerboseDir($$;$$);
90	sub VPrint($$@);
91	sub Rationalize($;$);
92	sub Write($@);
93	sub ProcessTrailers($$);
94	sub WriteTrailerBuffer($$$);
95	sub AddNewTrailers($;@);
96	sub Tell($);
97	sub WriteValue($$;$$$$);
98	sub WriteDirectory($$$;$);
99	sub WriteBinaryData($$$);
100	sub CheckBinaryData($$$);
101	sub WriteTIFF($$$);
102	sub Charset2Unicode($$;$);
103	sub Latin2Unicode($$);
104	sub UTF82Unicode($$;$);
105	sub Unicode2Charset($$;$);
106	sub Unicode2Latin($$;$);
107	sub Unicode2UTF8($$);
108	sub PackUTF8(@);
109	sub UnpackUTF8($);
110
111	# list of main tag tables to load in LoadAllTables() (sub-tables are recursed
112	# automatically). Note: They will appear in this order in the documentation
113	# (unless tweaked in BuildTagLookup::GetTableOrder()), so put Exif first.
114	@loadAllTables = qw(
115	PhotoMechanic Exif GeoTiff CanonRaw KyoceraRaw MinoltaRaw SigmaRaw JPEG
116	Jpeg2000 BMP BMP PICT PNG MNG MIFF PDF PostScript Photoshop::Header
117	FujiFilm::RAF Panasonic::Raw Sony::SR2SubIFD ID3 Vorbis FLAC APE
118	APE::NewHeader APE::OldHeader MPC MPEG::Audio MPEG::Video QuickTime
119	QuickTime::ImageFile Flash Flash::FLV Real::Media Real::Audio
120	Real::Metafile RIFF AIFF ASF DICOM MIE HTML
121	);
122
123	# recognized file types, in the order we test unknown files
124	# Notes: 1) There is no need to test for like types separately here
125	# 2) Put types with no file signature at end of list to avoid false matches
126	@fileTypes = qw(JPEG CRW TIFF GIF MRW RAF X3F JP2 PNG MIE MIFF PS PDF PSD XMP
127	BMP PPM RIFF AIFF ASF MOV MPEG Real SWF FLV OGG FLAC APE MPC
128	ICC HTML VRD QTIF FPX PICT MP3 DICM RAW);
129
130	# file types that we can write (edit)
131	my @writeTypes = qw(JPEG TIFF GIF CRW MRW ORF PNG MIE PSD XMP PPM EPS PS ICC
132	VRD JP2);
133
134	# file types that we can create from scratch
135	my @createTypes = qw(XMP ICC MIE VRD);
136
137	# file type lookup for all recognized file extensions
138	my %fileTypeLookup = (
139	ACR => ['DICM', 'American College of Radiology ACR-NEMA'],
140	AI => [['PDF','PS'], 'Adobe Illustrator (PDF-like or PS-like)'],
141	AIF => ['AIFF', 'Audio Interchange File Format'],
142	AIFC => ['AIFF', 'Audio Interchange File Format Compressed'],
143	AIFF => ['AIFF', 'Audio Interchange File Format'],
144	APE => ['APE', "Monkey's Audio format"],
145	ARW => ['TIFF', 'Sony Alpha RAW format (TIFF-like)'],
146	ASF => ['ASF', 'Microsoft Advanced Systems Format'],
147	AVI => ['RIFF', 'Audio Video Interleaved (RIFF-based)'],
148	BMP => ['BMP', 'Windows BitMaP'],
149	BTF => ['BTF', 'Big Tagged Image File Format'],
150	CIFF => ['CRW', 'Camera Image File Format (same as CRW)'],
151	CR2 => ['TIFF', 'Canon RAW 2 format (TIFF-like)'],
152	CRW => ['CRW', 'Canon RAW format'],
153	CS1 => ['PSD', 'Sinar CaptureShop 1-Shot RAW (PSD-like)'],
154	DC3 => ['DICM', 'DICOM image file'],
155	DCM => ['DICM', 'DICOM image file'],
156	DIB => ['BMP', 'Device Independent Bitmap (aka. BMP)'],
157	DIC => ['DICM', 'DICOM image file'],
158	DICM => ['DICM', 'DICOM image file'],
159	DNG => ['TIFF', 'Digital Negative (TIFF-like)'],
160	DCR => ['TIFF', 'Kodak Digital Camera RAW (TIFF-like)'],
161	DOC => ['FPX', 'Microsoft Word Document (FPX-like)'],
162	EPS => ['EPS', 'Encapsulated PostScript Format'],
163	EPSF => ['EPS', 'Encapsulated PostScript Format'],
164	ERF => ['TIFF', 'Epson Raw Format (TIFF-like)'],
165	FLAC => ['FLAC', 'Free Lossless Audio Codec'],
166	FLV => ['FLV', 'Flash Video'],
167	FPX => ['FPX', 'FlashPix'],
168	GIF => ['GIF', 'Compuserve Graphics Interchange Format'],
169	HTM => ['HTML', 'HyperText Markup Language'],
170	HTML => ['HTML', 'HyperText Markup Language'],
171	ICC => ['ICC', 'International Color Consortium'],
172	ICM => ['ICC', 'International Color Consortium'],
173	JNG => ['PNG', 'JPG Network Graphics (PNG-like)'],
174	JP2 => ['JP2', 'JPEG 2000 file'],
175	JPEG => ['JPEG', 'Joint Photographic Experts Group'],
176	JPG => ['JPEG', 'Joint Photographic Experts Group'],
177	JPX => ['JP2', 'JPEG 2000 file'],
178	K25 => ['TIFF', 'Kodak DC25 RAW (TIFF-like)'],
179	M4A => ['MOV', 'MPG4 Audio (QuickTime-based)'],
180	MEF => ['TIFF', 'Mamiya (RAW) Electronic Format (TIFF-like)'],
181	MIE => ['MIE', 'Meta Information Encapsulation format'],
182	MIF => ['MIFF', 'Magick Image File Format'],
183	MIFF => ['MIFF', 'Magick Image File Format'],
184	MNG => ['PNG', 'Multiple-image Network Graphics (PNG-like)'],
185	MOS => ['TIFF', 'Creo Leaf Mosaic (TIFF-like)'],
186	MOV => ['MOV', 'Apple QuickTime movie'],
187	MP3 => ['MP3', 'MPEG Layer 3 audio (uses ID3 information)'],
188	MP4 => ['MOV', 'MPEG Layer 4 video (QuickTime-based)'],
189	MPC => ['MPC', 'Musepack Audio'],
190	MPEG => ['MPEG', 'MPEG audio/video format 1'],
191	MPG => ['MPEG', 'MPEG audio/video format 1'],
192	MRW => ['MRW', 'Minolta RAW format'],
193	NEF => ['TIFF', 'Nikon (RAW) Electronic Format (TIFF-like)'],
194	OGG => ['OGG', 'Ogg Vorbis audio file'],
195	ORF => ['ORF', 'Olympus RAW format'],
196	PBM => ['PPM', 'Portable BitMap (PPM-like)'],
197	PCT => ['PICT', 'Apple PICTure'],
198	PDF => ['PDF', 'Adobe Portable Document Format'],
199	PEF => ['TIFF', 'Pentax (RAW) Electronic Format (TIFF-like)'],
200	PGM => ['PPM', 'Portable Gray Map (PPM-like)'],
201	PICT => ['PICT', 'Apple PICTure'],
202	PNG => ['PNG', 'Portable Network Graphics'],
203	PPM => ['PPM', 'Portable Pixel Map'],
204	PPT => ['FPX', 'Microsoft PowerPoint presentation (FPX-like)'],
205	PS => ['PS', 'PostScript'],
206	PSD => ['PSD', 'PhotoShop Drawing'],
207	QIF => ['QTIF', 'QuickTime Image File'],
208	QT => ['MOV', 'QuickTime movie'],
209	QTI => ['QTIF', 'QuickTime Image File'],
210	QTIF => ['QTIF', 'QuickTime Image File'],
211	RA => ['Real', 'Real Audio'],
212	RAF => ['RAF', 'FujiFilm RAW Format'],
213	RAM => ['Real', 'Real Audio Metafile'],
214	RAW => ['RAW', 'Kyocera Contax N Digital RAW or Panasonic RAW'],
215	RIF => ['RIFF', 'Resource Interchange File Format'],
216	RIFF => ['RIFF', 'Resource Interchange File Format'],
217	RM => ['Real', 'Real Media'],
218	RMVB => ['Real', 'Real Media Variable Bitrate'],
219	RPM => ['Real', 'Real Media Plug-in Metafile'],
220	RV => ['Real', 'Real Video'],
221	SR2 => ['TIFF', 'Sony RAW Format 2 (TIFF-like)'],
222	SRF => ['TIFF', 'Sony RAW Format (TIFF-like)'],
223	SWF => ['SWF', 'Shockwave Flash'],
224	THM => ['JPEG', 'Canon Thumbnail (aka. JPG)'],
225	TIF => ['TIFF', 'Tagged Image File Format'],
226	TIFF => ['TIFF', 'Tagged Image File Format'],
227	VRD => ['VRD', 'Canon VRD Recipe Data (written by DPP)'],
228	WAV => ['RIFF', 'WAVeform (Windows digital audio format)'],
229	WDP => ['TIFF', 'Windows Media Photo (TIFF-based)'],
230	WMA => ['ASF', 'Windows Media Audio (ASF-based)'],
231	WMV => ['ASF', 'Windows Media Video (ASF-based)'],
232	X3F => ['X3F', 'Sigma RAW format'],
233	XHTML=> ['HTML', 'Extensible HyperText Markup Language'],
234	XLS => ['FPX', 'Microsoft Excel worksheet (FPX-like)'],
235	XMP => ['XMP', 'Extensible Metadata Platform data file'],
236	);
237
238	# MIME types for applicable file types above
239	# (missing entries default to 'application/unknown')
240	my %mimeType = (
241	AIFF => 'audio/aiff',
242	APE => 'audio/x-monkeys-audio',
243	ASF => 'video/x-ms-asf',
244	ARW => 'image/x-raw',
245	AVI => 'video/avi',
246	BMP => 'image/bmp',
247	BTF => 'application/unknown', #TEMPORARY!
248	CR2 => 'image/x-raw',
249	CRW => 'image/x-raw',
250	EPS => 'application/postscript',
251	ERF => 'image/x-raw',
252	DCR => 'image/x-raw',
253	DICM => 'application/dicom',
254	DNG => 'image/x-raw',
255	DOC => 'application/msword',
256	FLAC => 'audio/flac',
257	FLV => 'video/x-flv',
258	FPX => 'image/vnd.fpx',
259	GIF => 'image/gif',
260	HTML => 'text/html',
261	JNG => 'image/jng',
262	JP2 => 'image/jpeg2000',
263	JPEG => 'image/jpeg',
264	K25 => 'image/x-raw',
265	M4A => 'audio/mp4',
266	MEF => 'image/x-raw',
267	MIE => 'application/x-mie',
268	MIFF => 'application/x-magick-image',
269	MNG => 'video/mng',
270	MOS => 'image/x-raw',
271	MOV => 'video/quicktime',
272	MP3 => 'audio/mpeg',
273	MP4 => 'video/mp4',
274	MPC => 'audio/x-musepack',
275	MPEG => 'video/mpeg',
276	MRW => 'image/x-raw',
277	NEF => 'image/x-raw',
278	OGG => 'audio/x-ogg',
279	ORF => 'image/x-raw',
280	PBM => 'image/x-portable-bitmap',
281	PDF => 'application/pdf',
282	PEF => 'image/x-raw',
283	PGM => 'image/x-portable-graymap',
284	PICT => 'image/pict',
285	PNG => 'image/png',
286	PPM => 'image/x-portable-pixmap',
287	PPT => 'application/vnd.ms-powerpoint',
288	PS => 'application/postscript',
289	PSD => 'application/photoshop',
290	QTIF => 'image/x-quicktime',
291	RA => 'audio/x-pn-realaudio',
292	RAF => 'image/x-raw',
293	RAM => 'audio/x-pn-realaudio',
294	RAW => 'image/x-raw',
295	RM => 'application/vnd.rn-realmedia',
296	RMVB => 'application/vnd.rn-realmedia-vbr',
297	RPM => 'audio/x-pn-realaudio-plugin',
298	RV => 'video/vnd.rn-realvideo',
299	SR2 => 'image/x-raw',
300	SRF => 'image/x-raw',
301	SWF => 'application/x-shockwave-flash',
302	TIFF => 'image/tiff',
303	WAV => 'audio/x-wav',
304	WDP => 'image/vnd.ms-photo',
305	WMA => 'audio/x-ms-wma',
306	WMV => 'video/x-ms-wmv',
307	X3F => 'image/x-raw',
308	XLS => 'application/vnd.ms-excel',
309	XMP => 'application/rdf+xml',
310	);
311
312	# module names for each file type
313	# (missing entries have same module name as file type)
314	my %moduleName = (
315	BTF => 'BigTIFF',
316	CRW => 'CanonRaw',
317	DICM => 'DICOM',
318	EPS => 'PostScript',
319	ICC => 'ICC_Profile',
320	FLV => 'Flash',
321	FPX => 'FlashPix',
322	JP2 => 'Jpeg2000',
323	JPEG => '', # (in the current module)
324	MOV => 'QuickTime',
325	MP3 => 'ID3',
326	MRW => 'MinoltaRaw',
327	OGG => 'Vorbis',
328	ORF => 'Olympus',
329	PS => 'PostScript',
330	PSD => 'Photoshop',
331	QTIF => 'QuickTime',
332	RAF => 'FujiFilm',
333	RAW => 'KyoceraRaw',
334	SWF => 'Flash',
335	TIFF => '',
336	VRD => 'CanonVRD',
337	X3F => 'SigmaRaw',
338	);
339
340	# default group priority for writing
341	my @defaultWriteGroups = qw(EXIF IPTC XMP MakerNotes Photoshop ICC_Profile CanonVRD);
342
343	# group hash for ExifTool-generated tags
344	my %allGroupsExifTool = ( 0 => 'ExifTool', 1 => 'ExifTool', 2 => 'ExifTool' );
345
346	# headers for various segment types
347	$exifAPP1hdr = "Exif\0\0";
348	$xmpAPP1hdr = "http://ns.adobe.com/xap/1.0/\0";
349	$psAPP13hdr = "Photoshop 3.0\0";
350	$psAPP13old = 'Adobe_Photoshop2.5:';
351
352	sub DummyWriteProc { return 1; }
353
354	# tag information for preview image -- this should be used for all
355	# PreviewImage tags so they are handled properly when reading/writing
356	%Image::ExifTool::previewImageTagInfo = (
357	Name => 'PreviewImage',
358	Writable => 'undef',
359	# a value of 'none' is ok...
360	WriteCheck => '$val eq "none" ? undef : $self->CheckImage(\$val)',
361	DataTag => 'PreviewImage',
362	# we allow preview image to be set to '', but we don't want a zero-length value
363	# in the IFD, so set it temorarily to 'none'. Note that the length is <= 4,
364	# so this value will fit in the IFD so the preview fixup won't be generated.
365	ValueConv => '$self->ValidateImage(\$val,$tag)',
366	ValueConvInv => '$val eq "" and $val="none"; $val',
367	);
368
369	# extra tags that aren't truly EXIF tags, but are generated by the script
370	# Note: any tag in this list with a name corresponding to a Group0 name is
371	# used to write the entire corresponding directory as a block.
372	%Image::ExifTool::Extra = (
373	GROUPS => { 0 => 'File', 1 => 'File', 2 => 'Image' },
374	DID_TAG_ID => 1, # tag ID's aren't meaningful for these tags
375	WRITE_PROC => \&DummyWriteProc,
376	Comment => {
377	Notes => 'comment embedded in JPEG, GIF89a or PPM/PGM/PBM image',
378	Writable => 1,
379	WriteGroup => 'Comment',
380	Priority => 0, # to preserve order of JPEG COM segments
381	},
382	Directory => {
383	Writable => 1,
384	Protected => 1,
385	# translate backslashes in directory names and add trailing '/'
386	ValueConvInv => '$_=$val; tr/\\\\/\//; m{[^/]$} and $_ .= "/"; $_',
387	},
388	FileName => {
389	Writable => 1,
390	Protected => 1,
391	ValueConvInv => '$val=~tr/\\\\/\//; $val',
392	},
393	FileSize => {
394	PrintConv => sub {
395	my $val = shift;
396	$val < 2048 and return "$val bytes";
397	$val < 2097152 and return sprintf('%.0f kB', $val / 1024);
398	return sprintf('%.0f MB', $val / 1048576);
399	},
400	},
401	FileType => { },
402	FileModifyDate => {
403	Description => 'File Modification Date/Time',
404	Notes => 'the filesystem modification time',
405	Groups => { 2 => 'Time' },
406	Writable => 1,
407	Shift => 'Time',
408	ValueConv => 'ConvertUnixTime($val,"local")',
409	ValueConvInv => 'GetUnixTime($val,"local")',
410	PrintConv => '$self->ConvertDateTime($val)',
411	PrintConvInv => '$val',
412	},
413	MIMEType => { },
414	ImageWidth => { },
415	ImageHeight => { },
416	XResolution => { },
417	YResolution => { },
418	MaxVal => { }, # max pixel value in PPM or PGM image
419	EXIF => {
420	Notes => 'the full EXIF data block',
421	Groups => { 0 => 'EXIF' },
422	Binary => 1,
423	},
424	ICC_Profile => {
425	Notes => 'the full ICC_Profile data block',
426	Groups => { 0 => 'ICC_Profile' },
427	Flags => ['Writable' ,'Protected', 'Binary'],
428	WriteCheck => q{
429	require Image::ExifTool::ICC_Profile;
430	return Image::ExifTool::ICC_Profile::ValidateICC(\$val);
431	},
432	},
433	XMP => {
434	Notes => 'the full XMP data block',
435	Groups => { 0 => 'XMP' },
436	Flags => [ 'Writable', 'Binary' ],
437	WriteCheck => q{
438	require Image::ExifTool::XMP;
439	return Image::ExifTool::XMP::CheckXMP($self, $tagInfo, \$val);
440	},
441	},
442	CanonVRD => {
443	Notes => 'the full Canon DPP VRD trailer block',
444	Groups => { 0 => 'CanonVRD' },
445	Flags => ['Writable' ,'Protected', 'Binary'],
446	WriteCheck => q{
447	return undef if $val =~ /^CANON OPTIONAL DATA\0/;
448	return 'Invalid CanonVRD data';
449	},
450	},
451	Encryption => { }, # PDF encryption filter
452	ExifByteOrder => {
453	Writable => 1,
454	Notes => 'only writable for newly created EXIF segments',
455	PrintConv => {
456	II => 'Little-endian (Intel)',
457	MM => 'Big-endian (Motorola)',
458	},
459	},
460	ExifToolVersion => {
461	Description => 'ExifTool Version Number',
462	Groups => \%allGroupsExifTool
463	},
464	Error => { Priority => 0, Groups => \%allGroupsExifTool },
465	Warning => { Priority => 0, Groups => \%allGroupsExifTool },
466	);
467
468	# information decoded from JPEG SOF frame
469	# (define this here to avoid loading JPEG.pm)
470	# (ref http://www.w3.org/Graphics/JPEG/itu-t81.pdf)
471	%Image::ExifTool::JPEG::SOF = (
472	GROUPS => { 0 => 'File', 1 => 'File', 2 => 'Image' },
473	NOTES => 'This information is extracted from the JPEG Start Of Frame segment.',
474	VARS => { NO_ID => 1 },
475	EncodingProcess => {
476	PrintHex => 1,
477	PrintConv => {
478	0x0 => 'Baseline DCT, Huffman coding',
479	0x1 => 'Extended sequential DCT, Huffman coding',
480	0x2 => 'Progressive DCT, Huffman coding',
481	0x3 => 'Lossless, Huffman coding',
482	0x5 => 'Sequential DCT, differential Huffman coding',
483	0x6 => 'Progressive DCT, differential Huffman coding',
484	0x7 => 'Lossless, Differential Huffman coding',
485	0x9 => 'Extended sequential DCT, arithmetic coding',
486	0xa => 'Progressive DCT, arithmetic coding',
487	0xb => 'Lossless, arithmetic coding',
488	0xd => 'Sequential DCT, differential arithmetic coding',
489	0xe => 'Progressive DCT, differential arithmetic coding',
490	0xf => 'Lossless, differential arithmetic coding',
491	}
492	},
493	BitsPerSample => { },
494	ImageHeight => { },
495	ImageWidth => { },
496	ColorComponents => { },
497	YCbCrSubSampling => {
498	Notes => 'calculated from components table',
499	PrintConv => {
500	'1 1' => 'YCbCr4:4:4 (1 1)',
501	'2 1' => 'YCbCr4:2:2 (2 1)',
502	'2 2' => 'YCbCr4:2:0 (2 2)',
503	'4 1' => 'YCbCr4:1:1 (4 1)',
504	'4 2' => 'YCbCr4:1:0 (4 2)',
505	'1 2' => 'YCbCr4:4:0 (1 2)',
506	},
507	},
508	);
509
510	# static private ExifTool variables
511
512	%allTables = ( ); # list of all tables loaded (except composite tags)
513	@tableOrder = ( ); # order the tables were loaded
514
515	my $didTagID; # flag indicating we are accessing tag ID's
516
517	# composite tags (accumulation of all Composite tag tables)
518	%Image::ExifTool::Composite = (
519	GROUPS => { 0 => 'Composite', 1 => 'Composite' },
520	DID_TAG_ID => 1, # want empty tagID's for composite tags
521	WRITE_PROC => \&DummyWriteProc,
522	);
523
524	# JFIF APP0 definitions
525	%Image::ExifTool::JFIF::Main = (
526	PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData,
527	WRITE_PROC => \&Image::ExifTool::WriteBinaryData,
528	CHECK_PROC => \&Image::ExifTool::CheckBinaryData,
529	GROUPS => { 0 => 'JFIF', 1 => 'JFIF', 2 => 'Image' },
530	DATAMEMBER => [ 2, 3, 5 ],
531	0 => {
532	Name => 'JFIFVersion',
533	Format => 'int8u[2]',
534	PrintConv => '$val=~tr/ /./;$val',
535	},
536	2 => {
537	Name => 'ResolutionUnit',
538	Writable => 1,
539	RawConv => '$$self{JFIFResolutionUnit} = $val',
540	PrintConv => {
541	0 => 'None',
542	1 => 'inches',
543	2 => 'cm',
544	},
545	Priority => -1,
546	},
547	3 => {
548	Name => 'XResolution',
549	Format => 'int16u',
550	Writable => 1,
551	Priority => -1,
552	RawConv => '$$self{JFIFXResolution} = $val',
553	},
554	5 => {
555	Name => 'YResolution',
556	Format => 'int16u',
557	Writable => 1,
558	Priority => -1,
559	RawConv => '$$self{JFIFYResolution} = $val',
560	},
561	);
562	%Image::ExifTool::JFIF::Extension = (
563	GROUPS => { 0 => 'JFIF', 1 => 'JFIF', 2 => 'Image' },
564	0x10 => {
565	Name => 'ThumbnailImage',
566	ValueConv => '$self->ValidateImage(\$val,$tag)',
567	},
568	);
569
570	# special tag names (not used for tag info)
571	my %specialTags = (
572	PROCESS_PROC=>1, WRITE_PROC=>1, CHECK_PROC=>1, GROUPS=>1, FORMAT=>1,
573	FIRST_ENTRY=>1, TAG_PREFIX=>1, PRINT_CONV=>1, DID_TAG_ID=>1, WRITABLE=>1,
574	NOTES=>1, IS_OFFSET=>1, EXTRACT_UNKNOWN=>1, NAMESPACE=>1, PREFERRED=>1,
575	PARENT=>1, PRIORITY=>1, WRITE_GROUP=>1, LANG_INFO=>1, VARS=>1,
576	DATAMEMBER=>1,
577	);
578
579	#------------------------------------------------------------------------------
580	# Warning handler routines (warning string stored in $evalWarning)
581	#
582	# Set warning message
583	# Inputs: 0) warning string (undef to reset warning)
584	sub SetWarning($) { $evalWarning = $_[0]; }
585
586	# Get warning message
587	sub GetWarning() { return $evalWarning; }
588
589	# Clean unnecessary information (line number, LF) from warning
590	# Inputs: 0) warning string or undef to use current warning
591	# Returns: cleaned warning
592	sub CleanWarning(;$)
593	{
594	my $str = shift;
595	unless (defined $str) {
596	return undef unless defined $evalWarning;
597	$str = $evalWarning;
598	}
599	$str = $1 if $str =~ /(.*) at /s;
600	$str =~ s/\s+$//s;
601	return $str;
602	}
603
604	#==============================================================================
605	# New - create new ExifTool object
606	# Inputs: 0) reference to exiftool object or ExifTool class name
607	sub new
608	{
609	local $_;
610	my $that = shift;
611	my $class = ref($that) \|\| $that \|\| 'Image::ExifTool';
612	my $self = bless {}, $class;
613
614	# make sure our main Exif tag table has been loaded
615	GetTagTable("Image::ExifTool::Exif::Main");
616
617	$self->ClearOptions(); # create default options hash
618	$self->{VALUE} = { }; # must initialize this for warning messages
619	$self->{DEL_GROUP} = { }; # list of groups to delete when writing
620
621	# initialize our new groups for writing
622	$self->SetNewGroups(@defaultWriteGroups);
623
624	return $self;
625	}
626
627	#------------------------------------------------------------------------------
628	# ImageInfo - return specified information from image file
629	# Inputs: 0) [optional] ExifTool object reference
630	# 1) filename, file reference, or scalar data reference
631	# 2-N) list of tag names to find (or tag list reference or options reference)
632	# Returns: reference to hash of tag/value pairs (with "Error" entry on error)
633	# Notes:
634	# - if no tags names are specified, the values of all tags are returned
635	# - tags may be specified with leading '-' to exclude
636	# - can pass a reference to list of tags to find, in which case the list will
637	# be updated with the tags found in the proper case and in the specified order.
638	# - can pass reference to hash specifying options
639	# - returned tag values may be scalar references indicating binary data
640	# - see ClearOptions() below for a list of options and their default values
641	# Examples:
642	# use Image::ExifTool 'ImageInfo';
643	# my $info = ImageInfo($file, 'DateTimeOriginal', 'ImageSize');
644	# - or -
645	# my $exifTool = new Image::ExifTool;
646	# my $info = $exifTool->ImageInfo($file, \@tagList, {Sort=>'Group0'} );
647	sub ImageInfo($;@)
648	{
649	local $_;
650	# get our ExifTool object ($self) or create one if necessary
651	my $self;
652	if (ref $_[0] and UNIVERSAL::isa($_[0],'Image::ExifTool')) {
653	$self = shift;
654	} else {
655	$self = new Image::ExifTool;
656	}
657	my %saveOptions = %{$self->{OPTIONS}}; # save original options
658
659	# initialize file information
660	$self->{FILENAME} = $self->{RAF} = undef;
661
662	$self->ParseArguments(@_); # parse our function arguments
663	$self->ExtractInfo(undef); # extract meta information from image
664	my $info = $self->GetInfo(undef); # get requested information
665
666	$self->{OPTIONS} = \%saveOptions; # restore original options
667
668	return $info; # return requested information
669	}
670
671	#------------------------------------------------------------------------------
672	# Get/set ExifTool options
673	# Inputs: 0) ExifTool object reference,
674	# 1) Parameter name, 2) Value to set the option
675	# 3-N) More parameter/value pairs
676	# Returns: original value of last option specified
677	sub Options($$;@)
678	{
679	local $_;
680	my $self = shift;
681	my $options = $$self{OPTIONS};
682	my $oldVal;
683
684	while (@_) {
685	my $param = shift;
686	$oldVal = $options->{$param};
687	last unless @_;
688	$options->{$param} = shift;
689	# clone Exclude list and expand shortcuts
690	if ($param eq 'Exclude' and defined $options->{$param}) {
691	my @exclude;
692	my $val = $options->{$param};
693	if (ref $val eq 'ARRAY') {
694	@exclude = @$val;
695	} else {
696	@exclude = ($val);
697	}
698	ExpandShortcuts(\@exclude);
699	$options->{$param} = \@exclude;
700	}
701	}
702	return $oldVal;
703	}
704
705	#------------------------------------------------------------------------------
706	# ClearOptions - set options to default values
707	# Inputs: 0) ExifTool object reference
708	sub ClearOptions($)
709	{
710	local $_;
711	my $self = shift;
712
713	# create options hash with default values
714	# (commented out options don't need initializing)
715	$self->{OPTIONS} = {
716	# Binary => undef, # flag to extract binary values even if tag not specified
717	# ByteOrder => undef, # default byte order when creating EXIF information
718	Charset => 'UTF8', # character set for converting Unicode characters
719	# Compact => undef, # compact XMP and IPTC data
720	Composite => 1, # flag to calculate Composite tags
721	# Compress => undef, # flag to write new values as compressed if possible
722	# CoordFormat => undef, # GPS lat/long coordinate format
723	# DateFormat => undef, # format for date/time
724	Duplicates => 1, # flag to save duplicate tag values
725	# Exclude => undef, # tags to exclude
726	# FastScan => undef, # flag to avoid scanning for trailer
727	# FixBase => undef, # fix maker notes base offsets
728	# Group# => undef, # return tags for specified groups in family #
729	HtmlDump => 0, # HTML dump (0-3, higher # = bigger limit)
730	# HtmlDumpBase => undef, # base address for HTML dump
731	# IgnoreMinorErrors => undef, # ignore minor errors when reading/writing
732	# List => undef, # extract lists of PrintConv values into arrays
733	# MakerNotes => undef, # extract maker notes as a block
734	# MissingTagValue =>undef,# value for missing tags when expanded in expressions
735	PrintConv => 1, # flag to enable print conversion
736	# ScanForXMP => undef, # flag to scan for XMP information in all files
737	Sort => 'Input', # order to sort found tags (Input, File, Alpha, Group#)
738	# StrictDate => undef, # flag to return undef for invalid date conversions
739	TextOut => \*STDOUT,# file for Verbose/HtmlDump output
740	Unknown => 0, # flag to get values of unknown tags (0-2)
741	Verbose => 0, # print verbose messages (0-4, higher # = more verbose)
742	};
743	}
744
745	#------------------------------------------------------------------------------
746	# Extract meta information from image
747	# Inputs: 0) ExifTool object reference
748	# 1-N) Same as ImageInfo()
749	# Returns: 1 if this was a valid image, 0 otherwise
750	# Notes: pass an undefined value to avoid parsing arguments
751	sub ExtractInfo($;@)
752	{
753	local $_;
754	my $self = shift;
755	my $options = $self->{OPTIONS}; # pointer to current options
756	my %saveOptions;
757
758	if (defined $_[0] or $options->{HtmlDump}) {
759	%saveOptions = %$options; # save original options
760
761	# require duplicates for html dump
762	$self->Options(Duplicates => 1) if $options->{HtmlDump};
763
764	if (defined $_[0]) {
765	# only initialize filename if called with arguments
766	$self->{FILENAME} = undef; # name of file (or '' if we didn't open it)
767	$self->{RAF} = undef; # RandomAccess object reference
768
769	$self->ParseArguments(@_); # initialize from our arguments
770	}
771	}
772	# initialize ExifTool object members
773	$self->Init();
774
775	delete $self->{MAKER_NOTE_FIXUP}; # fixup information for extracted maker notes
776	delete $self->{MAKER_NOTE_BYTE_ORDER};
777	delete $self->{DONE_ID3};
778
779	my $filename = $self->{FILENAME}; # image file name ('' if already open)
780	my $raf = $self->{RAF}; # RandomAccess object
781
782	# return our version number
783	$self->FoundTag('ExifToolVersion', "$VERSION$RELEASE");
784
785	local *EXIFTOOL_FILE; # avoid clashes with global namespace
786
787	unless ($raf) {
788	# save file name
789	if (defined $filename and $filename ne '') {
790	unless ($filename eq '-') {
791	my $name = $filename;
792	# extract file name from pipe if necessary
793	$name =~ /\\|$/ and $name =~ s/.?"(.)".*/$1/;
794	my $dir;
795	if (eval 'require File::Basename') {
796	$dir = File::Basename::dirname($name);
797	$name = File::Basename::basename($name);
798	} else {
799	$name =~ tr/\\/\//;
800	if ($name =~ s/(.*)\///) { # remove path
801	$dir = length($1) ? $1 : '/';
802	}
803	}
804	$self->FoundTag('FileName', $name);
805	$self->FoundTag('Directory', $dir) if defined $dir and length $dir;
806	}
807	# open the file
808	if (open(EXIFTOOL_FILE,$filename)) {
809	my $filePt = \*EXIFTOOL_FILE;
810	# create random access file object
811	$raf = new File::RandomAccess($filePt);
812	# patch to force pipe to be buffered because seek returns success
813	# in Windows cmd shell pipe even though it really failed
814	$raf->{TESTED} = -1 if $filename eq '-' or $filename =~ /\\|$/;
815	$self->{RAF} = $raf;
816	} else {
817	$self->Error('Error opening file');
818	}
819	} else {
820	$self->Error('No file specified');
821	}
822	}
823
824	if ($raf) {
825	# get file size and last modified time if this is a plain file
826	if ($raf->{FILE_PT} and -f $raf->{FILE_PT}) {
827	my $fileSize = -s _;
828	my $fileTime = -M _;
829	$self->FoundTag('FileSize', $fileSize) if defined $fileSize;
830	$self->FoundTag('FileModifyDate', $^T - $fileTime(243600)) if defined $fileTime;
831	}
832
833	# get list of file types to check
834	my $tiffType;
835	$self->{FILE_EXT} = GetFileExtension($filename);
836	my @fileTypeList = GetFileType($filename);
837	if (@fileTypeList) {
838	# add remaining types to end of list so we test them all
839	my $pat = join '\|', @fileTypeList;
840	push @fileTypeList, grep(!/^($pat)$/, @fileTypes);
841	$tiffType = $self->{FILE_EXT};
842	} else {
843	# scan through all recognized file types
844	@fileTypeList = @fileTypes;
845	$tiffType = 'TIFF';
846	}
847	push @fileTypeList, ''; # end of list marker
848	# initialize the input file for seeking in binary data
849	$raf->BinMode(); # set binary mode before we start reading
850	my $pos = $raf->Tell(); # get file position so we can rewind
851	my %dirInfo = ( RAF => $raf, Base => $pos );
852	# loop through list of file types to test
853	my $type;
854	for (;;) {
855	$type = shift @fileTypeList;
856	unless ($type) {
857	last unless defined $type;
858	# last ditch effort to scan past unknown header for JPEG/TIFF
859	my $buff;
860	$raf->Read($buff, 1024);
861	next unless $buff =~ /(\xff\xd8\xff\|MM\0\x2a\|II\x2a\0)/g;
862	$type = ($1 eq "\xff\xd8\xff") ? 'JPEG' : 'TIFF';
863	my $skip = pos($buff) - length($1);
864	$dirInfo{Base} = $pos + $skip;
865	$raf->Seek($pos + $skip, 0);
866	$self->Warn("Skipped unknown $skip byte header");
867	}
868	# save file type in member variable
869	$self->{FILE_TYPE} = $type;
870	$dirInfo{Parent} = ($type eq 'TIFF') ? $tiffType : $type;
871	my $module = $moduleName{$type};
872	$module = $type unless defined $module;
873	my $func = "Process$type";
874
875	# load module if necessary
876	if ($module) {
877	require "Image/ExifTool/$module.pm";
878	$func = "Image::ExifTool::${module}::$func";
879	}
880	# process the file
881	no strict 'refs';
882	&$func($self, \%dirInfo) and last;
883	use strict 'refs';
884
885	# seek back to try again from the same position in the file
886	unless ($raf->Seek($pos, 0)) {
887	$self->Error('Error seeking in file');
888	last;
889	}
890	}
891	# scan for XMP if specified
892	if ($self->Options('ScanForXMP') and (not defined $type or
893	(not $self->Options('FastScan') and not $$self{FoundXMP})))
894	{
895	$raf->Seek($pos, 0);
896	require Image::ExifTool::XMP;
897	Image::ExifTool::XMP::ScanForXMP($self, $raf) and $type = '';
898	}
899	unless (defined $type) {
900	# if we were given a single image with a known type there
901	# must be a format error since we couldn't read it, otherwise
902	# it is likely we don't support images of this type
903	$self->Error(GetFileType($filename) ?
904	'File format error' : 'Unknown file type');
905	}
906	# extract binary EXIF data block only if requested
907	if (defined $self->{EXIF_DATA} and $self->{REQ_TAG_LOOKUP}->{exif}) {
908	$self->FoundTag('EXIF', $self->{EXIF_DATA});
909	}
910	# calculate composite tags
911	$self->BuildCompositeTags() if $options->{Composite};
912
913	# do our HTML dump if requested
914	if ($self->{HTML_DUMP}) {
915	$raf->Seek(0, 2); # seek to end of file
916	$self->{HTML_DUMP}->FinishTiffDump($self, $raf->Tell());
917	my $pos = $options->{HtmlDumpBase};
918	$pos = ($self->{FIRST_EXIF_POS} \|\| 0) unless defined $pos;
919	my $dataPt = defined $self->{EXIF_DATA} ? \$self->{EXIF_DATA} : undef;
920	undef $dataPt if defined $self->{EXIF_POS} and $pos != $self->{EXIF_POS};
921	$self->{HTML_DUMP}->Print($raf, $dataPt, $pos,
922	$options->{TextOut}, $options->{HtmlDump},
923	$self->{FILENAME} ? "HTML Dump ($self->{FILENAME})" : 'HTML Dump');
924	}
925
926	$raf->Close() if $filename; # close the file if we opened it
927	}
928
929	# restore original options
930	%saveOptions and $self->{OPTIONS} = \%saveOptions;
931
932	return exists $self->{VALUE}->{Error} ? 0 : 1;
933	}
934
935	#------------------------------------------------------------------------------
936	# Get hash of extracted meta information
937	# Inputs: 0) ExifTool object reference
938	# 1-N) options hash reference, tag list reference or tag names
939	# Returns: Reference to information hash
940	# Notes: - pass an undefined value to avoid parsing arguments
941	# - If groups are specified, first groups take precedence if duplicate
942	# tags found but Duplicates option not set.
943	sub GetInfo($;@)
944	{
945	local $_;
946	my $self = shift;
947	my %saveOptions;
948
949	unless (@_ and not defined $_[0]) {
950	%saveOptions = %{$self->{OPTIONS}}; # save original options
951	# must set FILENAME so it isn't parsed from the arguments
952	$self->{FILENAME} = '' unless defined $self->{FILENAME};
953	$self->ParseArguments(@_);
954	}
955
956	# get reference to list of tags for which we will return info
957	my $rtnTags = $self->SetFoundTags();
958
959	# build hash of tag information
960	my (%info, %ignored);
961	my $conv = $self->{OPTIONS}->{PrintConv} ? 'PrintConv' : 'ValueConv';
962	foreach (@$rtnTags) {
963	my $val = $self->GetValue($_, $conv);
964	defined $val or $ignored{$_} = 1, next;
965	$info{$_} = $val;
966	}
967
968	# remove ignored tags from the list
969	my $reqTags = $self->{REQUESTED_TAGS} \|\| [ ];
970	if (%ignored and not @$reqTags) {
971	my @goodTags;
972	foreach (@$rtnTags) {
973	push @goodTags, $_ unless $ignored{$_};
974	}
975	$rtnTags = $self->{FOUND_TAGS} = \@goodTags;
976	}
977
978	# return sorted tag list if provided with a list reference
979	if ($self->{IO_TAG_LIST}) {
980	# use file order by default if no tags specified
981	# (no such thing as 'Input' order in this case)
982	my $sortOrder = $self->{OPTIONS}->{Sort};
983	unless (@$reqTags or ($sortOrder and $sortOrder ne 'Input')) {
984	$sortOrder = 'File';
985	}
986	# return tags in specified sort order
987	@{$self->{IO_TAG_LIST}} = $self->GetTagList($rtnTags, $sortOrder);
988	}
989
990	# restore original options
991	%saveOptions and $self->{OPTIONS} = \%saveOptions;
992
993	return \%info;
994	}
995
996	#------------------------------------------------------------------------------
997	# Combine information from a list of info hashes
998	# Unless Duplicates is enabled, first entry found takes priority
999	# Inputs: 0) ExifTool object reference, 1-N) list of info hash references
1000	# Returns: Combined information hash reference
1001	sub CombineInfo($;@)
1002	{
1003	local $_;
1004	my $self = shift;
1005	my (%combinedInfo, $info);
1006
1007	if ($self->{OPTIONS}->{Duplicates}) {
1008	while ($info = shift) {
1009	my $key;
1010	foreach $key (keys %$info) {
1011	$combinedInfo{$key} = $$info{$key};
1012	}
1013	}
1014	} else {
1015	my (%haveInfo, $tag);
1016	while ($info = shift) {
1017	foreach $tag (keys %$info) {
1018	my $tagName = GetTagName($tag);
1019	next if $haveInfo{$tagName};
1020	$haveInfo{$tagName} = 1;
1021	$combinedInfo{$tag} = $$info{$tag};
1022	}
1023	}
1024	}
1025	return \%combinedInfo;
1026	}
1027
1028	#------------------------------------------------------------------------------
1029	# Inputs: 0) ExifTool object reference
1030	# 1) [optional] reference to info hash or tag list ref (default is found tags)
1031	# 2) [optional] sort order ('File', 'Input', ...)
1032	# Returns: List of tags in specified order
1033	sub GetTagList($;$$)
1034	{
1035	local $_;
1036	my ($self, $info, $sortOrder) = @_;
1037
1038	my $foundTags;
1039	if (ref $info eq 'HASH') {
1040	my @tags = keys %$info;
1041	$foundTags = \@tags;
1042	} elsif (ref $info eq 'ARRAY') {
1043	$foundTags = $info;
1044	}
1045	my $fileOrder = $self->{FILE_ORDER};
1046
1047	if ($foundTags) {
1048	# make sure a FILE_ORDER entry exists for all tags
1049	# (note: already generated bogus entries for FOUND_TAGS case below)
1050	foreach (@$foundTags) {
1051	next if defined $$fileOrder{$_};
1052	$$fileOrder{$_} = 999;
1053	}
1054	} else {
1055	$sortOrder = $info if $info and not $sortOrder;
1056	$foundTags = $self->{FOUND_TAGS} \|\| $self->SetFoundTags() or return undef;
1057	}
1058	$sortOrder or $sortOrder = $self->{OPTIONS}->{Sort};
1059
1060	# return original list if no sort order specified
1061	return @$foundTags unless $sortOrder and $sortOrder ne 'Input';
1062
1063	if ($sortOrder eq 'Alpha') {
1064	return sort @$foundTags;
1065	} elsif ($sortOrder =~ /^Group(\d*)/) {
1066	my $family = $1 \|\| 0;
1067	# want to maintain a basic file order with the groups
1068	# ordered in the way they appear in the file
1069	my (%groupCount, %groupOrder);
1070	my $numGroups = 0;
1071	my $tag;
1072	foreach $tag (sort { $$fileOrder{$a} <=> $$fileOrder{$b} } @$foundTags) {
1073	my $group = $self->GetGroup($tag, $family);
1074	my $num = $groupCount{$group};
1075	$num or $num = $groupCount{$group} = ++$numGroups;
1076	$groupOrder{$tag} = $num;
1077	}
1078	return sort { $groupOrder{$a} <=> $groupOrder{$b} or
1079	$$fileOrder{$a} <=> $$fileOrder{$b} } @$foundTags;
1080	} else {
1081	return sort { $$fileOrder{$a} <=> $$fileOrder{$b} } @$foundTags;
1082	}
1083	}
1084
1085	#------------------------------------------------------------------------------
1086	# Get list of found tags in specified sort order
1087	# Inputs: 0) ExifTool object reference, 1) sort order ('File', 'Input', ...)
1088	# Returns: List of tags in specified order
1089	# Notes: If not specified, sort order is taken from OPTIONS
1090	sub GetFoundTags($;$)
1091	{
1092	local $_;
1093	my ($self, $sortOrder) = @_;
1094	my $foundTags = $self->{FOUND_TAGS} \|\| $self->SetFoundTags() or return undef;
1095	return $self->GetTagList($foundTags, $sortOrder);
1096	}
1097
1098	#------------------------------------------------------------------------------
1099	# Get list of requested tags
1100	# Inputs: 0) ExifTool object reference
1101	# Returns: List of requested tags
1102	sub GetRequestedTags($)
1103	{
1104	local $_;
1105	return @{$_[0]->{REQUESTED_TAGS}};
1106	}
1107
1108	#------------------------------------------------------------------------------
1109	# Get tag value
1110	# Inputs: 0) ExifTool object reference, 1) tag key
1111	# 2) [optional] Value type: PrintConv, ValueConv, Both or Raw, the default
1112	# is PrintConv or ValueConv, depending on the PrintConv option setting
1113	# Returns: Scalar context: tag value or undefined
1114	# List context: list of values or empty list
1115	sub GetValue($$;$)
1116	{
1117	local $_;
1118	my ($self, $tag, $type) = @_;
1119
1120	# start with the raw value
1121	my $value = $self->{VALUE}->{$tag};
1122	return wantarray ? () : undef unless defined $value;
1123
1124	# figure out what conversions to do
1125	my (@convTypes, $tagInfo);
1126	$type or $type = $self->{OPTIONS}->{PrintConv} ? 'PrintConv' : 'ValueConv';
1127	unless ($type eq 'Raw') {
1128	$tagInfo = $self->{TAG_INFO}->{$tag};
1129	push @convTypes, 'ValueConv';
1130	push @convTypes, 'PrintConv' unless $type eq 'ValueConv';
1131	}
1132
1133	# do the conversions
1134	my (@val, @prt, @raw, $convType, $valueConv);
1135	foreach $convType (@convTypes) {
1136	last if ref $value eq 'SCALAR'; # don't convert a scalar reference
1137	my $conv = $$tagInfo{$convType};
1138	unless (defined $conv) {
1139	if ($convType eq 'ValueConv') {
1140	next unless $$tagInfo{Binary};
1141	$conv = '\$val'; # return scalar reference for binary values
1142	} else {
1143	# use PRINT_CONV from tag table if PrintConv not defined
1144	next unless defined($conv = $tagInfo->{Table}->{PRINT_CONV});
1145	}
1146	}
1147	# save old ValueConv value if we want Both
1148	$valueConv = $value if $type eq 'Both' and $convType eq 'PrintConv';
1149	my ($i, $val, $vals, @values, $convList);
1150	# split into list if conversion is an array
1151	if (ref $conv eq 'ARRAY') {
1152	$convList = $conv;
1153	$conv = $$convList[0];
1154	my @valList = split ' ', $value;
1155	$value = \@valList;
1156	}
1157	# initialize array so we can iterate over values in list
1158	if (ref $value eq 'ARRAY') {
1159	$i = 0;
1160	$vals = $value;
1161	$val = $$vals[0];
1162	} else {
1163	$val = $value;
1164	}
1165	# loop through all values in list
1166	for (;;) {
1167	if (defined $conv) {
1168	# get values of required tags if this is a composite tag
1169	if (ref $val eq 'HASH' and not @val) {
1170	foreach (keys %$val) {
1171	$raw[$_] = $self->{VALUE}->{$$val{$_}};
1172	($val[$_], $prt[$_]) = $self->GetValue($$val{$_}, 'Both');
1173	next if defined $val[$_] or not $tagInfo->{Require}->{$_};
1174	return wantarray ? () : undef;
1175	}
1176	# set $val to $val[0], or \@val for a CODE ref conversion
1177	$val = ref $conv eq 'CODE' ? \@val : $val[0];
1178	}
1179	if (ref $conv eq 'HASH') {
1180	# look up converted value in hash
1181	unless (defined($value = $$conv{$val})) {
1182	if ($$conv{BITMASK}) {
1183	$value = DecodeBits($val, $$conv{BITMASK});
1184	} else {
1185	if ($$tagInfo{PrintHex} and $val and IsInt($val) and
1186	$convType eq 'PrintConv')
1187	{
1188	$val = sprintf('0x%x',$val);
1189	}
1190	$value = "Unknown ($val)";
1191	}
1192	}
1193	} else {
1194	# call subroutine or do eval to convert value
1195	local $SIG{'__WARN__'} = \&SetWarning;
1196	undef $evalWarning;
1197	if (ref $conv eq 'CODE') {
1198	$value = &$conv($val, $self);
1199	} else {
1200	#### eval ValueConv/PrintConv ($val, $self, @val, @prt, @raw)
1201	$value = eval $conv;
1202	$@ and $evalWarning = $@;
1203	}
1204	if ($evalWarning) {
1205	delete $SIG{'__WARN__'};
1206	warn "$convType $tag: " . CleanWarning() . "\n";
1207	}
1208	}
1209	} else {
1210	$value = $val;
1211	}
1212	last unless $vals;
1213	# save this converted value and step to next value in list
1214	push @values, $value if defined $value;
1215	if (++$i >= scalar(@$vals)) {
1216	$value = \@values if @values;
1217	last;
1218	}
1219	$val = $$vals[$i];
1220	$conv = $$convList[$i] if $convList;
1221	}
1222	# return undefined now if no value
1223	return wantarray ? () : undef unless defined $value;
1224	# join back into single value if split for conversion list
1225	if ($convList and ref $value eq 'ARRAY') {
1226	$value = join($convType eq 'PrintConv' ? '; ' : ' ', @$value);
1227	}
1228	}
1229	if ($type eq 'Both') {
1230	# $valueConv is undefined if there was no print conversion done
1231	$valueConv = $value unless defined $valueConv;
1232	# return Both values as a list (ValueConv, PrintConv)
1233	return ($valueConv, $value);
1234	}
1235	if (ref $value eq 'ARRAY') {
1236	# return array if requested
1237	return @$value if wantarray;
1238	# return list reference for Raw, ValueConv or if List option set
1239	return $value if @convTypes < 2 or $self->{OPTIONS}->{List};
1240	# otherwise join in comma-separated string
1241	$value = join ', ', @$value;
1242	}
1243	return $value;
1244	}
1245
1246	#------------------------------------------------------------------------------
1247	# Get tag identification number
1248	# Inputs: 0) ExifTool object reference, 1) tag key
1249	# Returns: Tag ID if available, otherwise ''
1250	sub GetTagID($$)
1251	{
1252	local $_;
1253	my ($self, $tag) = @_;
1254	my $tagInfo = $self->{TAG_INFO}->{$tag};
1255
1256	if ($tagInfo) {
1257	GenerateAllTagIDs(); # make sure tag ID's are generated
1258	defined $$tagInfo{TagID} and return $$tagInfo{TagID};
1259	}
1260	# no ID for this tag (shouldn't happen)
1261	return '';
1262	}
1263
1264	#------------------------------------------------------------------------------
1265	# Get description for specified tag
1266	# Inputs: 0) ExifTool object reference, 1) tag key
1267	# Returns: Tag description
1268	# Notes: Will always return a defined value, even if description isn't available
1269	sub GetDescription($$)
1270	{
1271	local $_;
1272	my ($self, $tag) = @_;
1273	my $tagInfo = $self->{TAG_INFO}->{$tag};
1274	# ($tagInfo should be defined for any extracted tag,
1275	# but we might as well handle the case where it isn't)
1276	my $desc;
1277	$desc = $$tagInfo{Description} if $tagInfo;
1278	# just make the tag more readable if description doesn't exist
1279	unless ($desc) {
1280	$desc = MakeDescription(GetTagName($tag));
1281	# save description in tag information
1282	$$tagInfo{Description} = $desc if $tagInfo;
1283	}
1284	return $desc;
1285	}
1286
1287	#------------------------------------------------------------------------------
1288	# Get group name for specified tag
1289	# Inputs: 0) ExifTool object reference
1290	# 1) tag key (or reference to tagInfo hash, not part of the public API)
1291	# 2) [optional] group family number (-1 to get extended group list)
1292	# Returns: Scalar context: Group name (for family 0 if not otherwise specified)
1293	# Array context: Group name if family specified, otherwise list of
1294	# group names for each family.
1295	sub GetGroup($$;$)
1296	{
1297	local $_;
1298	my ($self, $tag, $family) = @_;
1299	my ($tagInfo, @groups, $extra);
1300	if (ref $tag eq 'HASH') {
1301	$tagInfo = $tag;
1302	$tag = $tagInfo->{Name};
1303	} else {
1304	$tagInfo = $self->{TAG_INFO}->{$tag} or return '';
1305	}
1306	my $groups = $$tagInfo{Groups};
1307	# fill in default groups unless already done
1308	unless ($$tagInfo{GotGroups}) {
1309	my $tagTablePtr = $$tagInfo{Table};
1310	if ($tagTablePtr) {
1311	# construct our group list
1312	$groups or $groups = $$tagInfo{Groups} = { };
1313	# fill in default groups
1314	foreach (keys %{$$tagTablePtr{GROUPS}}) {
1315	$$groups{$_} or $$groups{$_} = $tagTablePtr->{GROUPS}->{$_};
1316	}
1317	}
1318	# set flag indicating group list was built
1319	$$tagInfo{GotGroups} = 1;
1320	}
1321	if (defined $family and $family >= 0) {
1322	return $$groups{$family} \|\| 'Other' unless $family == 1;
1323	$groups[$family] = $$groups{$family};
1324	} else {
1325	return $$groups{0} unless wantarray;
1326	foreach (0..2) { $groups[$_] = $$groups{$_}; }
1327	}
1328	# modify family 1 group name if necessary
1329	if ($extra = $self->{GROUP1}->{$tag}) {
1330	if ($extra =~ /^\+(.*)/) {
1331	$groups[1] .= $1;
1332	} else {
1333	$groups[1] = $extra;
1334	}
1335	}
1336	if ($family) {
1337	return $groups[1] if $family == 1;
1338	# add additional matching group names to list
1339	# ie) for MIE-Doc, also add MIE1, MIE1-Doc, MIE-Doc1 and MIE1-Doc1
1340	# and for MIE2-Doc3, also add MIE2, MIE-Doc3, MIE2-Doc and MIE-Doc
1341	if ($groups[1] =~ /^MIE(\d)-(.+?)(\d)$/) {
1342	push @groups, 'MIE' . ($1 \|\| '1');
1343	push @groups, 'MIE' . ($1 ? '' : '1') . "-$2$3";
1344	push @groups, "MIE$1-$2" . ($3 ? '' : '1');
1345	push @groups, 'MIE' . ($1 ? '' : '1') . "-$2" . ($3 ? '' : '1');
1346	}
1347	}
1348	return @groups;
1349	}
1350
1351	#------------------------------------------------------------------------------
1352	# Get group names for specified tags
1353	# Inputs: 0) ExifTool object reference
1354	# 1) [optional] information hash reference (default all extracted info)
1355	# 2) [optional] group family number (default 0)
1356	# Returns: List of group names in alphabetical order
1357	sub GetGroups($;$$)
1358	{
1359	local $_;
1360	my $self = shift;
1361	my $info = shift;
1362	my $family;
1363
1364	# figure out our arguments
1365	if (ref $info ne 'HASH') {
1366	$family = $info;
1367	$info = $self->{VALUE};
1368	} else {
1369	$family = shift;
1370	}
1371	$family = 0 unless defined $family;
1372
1373	# get a list of all groups in specified information
1374	my ($tag, %groups);
1375	foreach $tag (keys %$info) {
1376	$groups{ $self->GetGroup($tag, $family) } = 1;
1377	}
1378	return sort keys %groups;
1379	}
1380
1381	#------------------------------------------------------------------------------
1382	# Set priority for group where new values are written
1383	# Inputs: 0) ExifTool object reference,
1384	# 1-N) group names (reset to default if no groups specified)
1385	sub SetNewGroups($;@)
1386	{
1387	local $_;
1388	my ($self, @groups) = @_;
1389	@groups or @groups = @defaultWriteGroups;
1390	my $count = @groups;
1391	my %priority;
1392	foreach (@groups) {
1393	$priority{lc($_)} = $count--;
1394	}
1395	$priority{file} = 10; # 'File' group is always written (Comment)
1396	$priority{composite} = 10; # 'Composite' group is always written
1397	# set write priority (higher # is higher priority)
1398	$self->{WRITE_PRIORITY} = \%priority;
1399	$self->{WRITE_GROUPS} = \@groups;
1400	}
1401
1402	#------------------------------------------------------------------------------
1403	# Build composite tags from required tags
1404	# Inputs: 0) ExifTool object reference
1405	# Note: Tag values are calculated in alphabetical order unless a tag Require's
1406	# or Desire's another composite tag, in which case the calculation is
1407	# deferred until after the other tag is calculated.
1408	sub BuildCompositeTags($)
1409	{
1410	local $_;
1411	my $self = shift;
1412
1413	# first, add user-defined composite tags if necessary
1414	if (defined %UserDefined and $UserDefined{'Image::ExifTool::Composite'}) {
1415	AddCompositeTags($UserDefined{'Image::ExifTool::Composite'},1);
1416	delete $UserDefined{'Image::ExifTool::Composite'};
1417	}
1418	my @tagList = sort keys %Image::ExifTool::Composite;
1419	my %tagsUsed;
1420
1421	my $rawValue = $self->{VALUE};
1422	for (;;) {
1423	my %notBuilt;
1424	foreach (@tagList) {
1425	$notBuilt{$_} = 1;
1426	}
1427	my @deferredTags;
1428	my $tag;
1429	COMPOSITE_TAG:
1430	foreach $tag (@tagList) {
1431	next if $specialTags{$tag};
1432	my $tagInfo = $self->GetTagInfo(\%Image::ExifTool::Composite, $tag);
1433	next unless $tagInfo;
1434	# put required tags into array and make sure they all exist
1435	my (%tagKey, $type, $found);
1436	foreach $type ('Require','Desire') {
1437	my $req = $$tagInfo{$type} or next;
1438	# save Require'd and Desire'd tag values in list
1439	my $index;
1440	foreach $index (keys %$req) {
1441	my $reqTag = $$req{$index};
1442	# allow tag group to be specified
1443	if ($reqTag =~ /(.+?):(.+)/) {
1444	my ($reqGroup, $name) = ($1, $2);
1445	my $family;
1446	$family = $1 if $reqGroup =~ s/^(\d+)//;
1447	my $i = 0;
1448	for (;;++$i) {
1449	$reqTag = $name;
1450	$reqTag .= " ($i)" if $i;
1451	last unless defined $$rawValue{$reqTag};
1452	my @groups = $self->GetGroup($reqTag, $family);
1453	last if grep { $reqGroup eq $_ } @groups;
1454	}
1455	} elsif ($notBuilt{$reqTag}) {
1456	# calculate this tag later if it relies on another
1457	# Composite tag which hasn't been calculated yet
1458	push @deferredTags, $tag;
1459	next COMPOSITE_TAG;
1460	}
1461	if (defined $$rawValue{$reqTag}) {
1462	$found = 1;
1463	} else {
1464	# don't continue if we require this tag
1465	$type eq 'Require' and next COMPOSITE_TAG;
1466	}
1467	$tagKey{$index} = $reqTag;
1468	}
1469	}
1470	delete $notBuilt{$tag}; # this tag is OK to build now
1471	next unless $found; # can't build tag if no values found
1472	# keep track of all require'd tag keys
1473	foreach (keys %tagKey) {
1474	# only tag keys with same name as a composite tag can be replaced
1475	# (also eliminates keys with instance numbers which can't be replaced either)
1476	next unless $Image::ExifTool::Composite{$tagKey{$_}};
1477	my $keyRef = \$tagKey{$_};
1478	$tagsUsed{$$keyRef} or $tagsUsed{$$keyRef} = [ ];
1479	push @{$tagsUsed{$$keyRef}}, $keyRef;
1480	}
1481	# save reference to tag key lookup as value for composite tag
1482	my $key = $self->FoundTag($tagInfo, \%tagKey);
1483	# check to see if we just replaced one of the tag keys we require'd
1484	next unless defined $key and $tagsUsed{$key};
1485	foreach (@{$tagsUsed{$key}}) {
1486	$$_ = $self->{MOVED_KEY}; # replace with new tag key
1487	}
1488	delete $tagsUsed{$key}; # can't be replaced again
1489	}
1490	last unless @deferredTags;
1491	if (@deferredTags == @tagList) {
1492	# everything was deferred in the last pass,
1493	# must be a circular dependency
1494	warn "Circular dependency in Composite tags\n";
1495	last;
1496	}
1497	@tagList = @deferredTags; # calculate deferred tags now
1498	}
1499	}
1500
1501	#------------------------------------------------------------------------------
1502	# Get tag name (removes copy index)
1503	# Inputs: 0) Tag key
1504	# Returns: Tag name
1505	sub GetTagName($)
1506	{
1507	local $_;
1508	$_[0] =~ /^(\S+)/;
1509	return $1;
1510	}
1511
1512	#------------------------------------------------------------------------------
1513	# Get list of shortcuts
1514	# Returns: Shortcut list (sorted alphabetically)
1515	sub GetShortcuts()
1516	{
1517	local $_;
1518	require Image::ExifTool::Shortcuts;
1519	return sort keys %Image::ExifTool::Shortcuts::Main;
1520	}
1521
1522	#------------------------------------------------------------------------------
1523	# Get file type for specified extension
1524	# Inputs: 0) file name or extension (case is not significant)
1525	# 1) flag to return long description instead of type
1526	# Returns: File type (or desc) or undef if extension not supported. In array
1527	# context, may return more than one file type if the file may be
1528	# different formats. Returns list of all recognized extensions if no
1529	# file specified
1530	sub GetFileType(;$$)
1531	{
1532	local $_;
1533	my ($file, $desc) = @_;
1534	return sort keys %fileTypeLookup unless defined $file;
1535	my $fileType;
1536	my $fileExt = GetFileExtension($file);
1537	$fileExt = uc($file) unless $fileExt;
1538	$fileExt and $fileType = $fileTypeLookup{$fileExt}; # look up the file type
1539	return $$fileType[1] if $desc; # return description if specified
1540	$fileType = $$fileType[0]; # get file type (or list of types)
1541	if (wantarray) {
1542	return () unless $fileType;
1543	return @$fileType if ref $fileType eq 'ARRAY';
1544	} elsif ($fileType) {
1545	$fileType = $fileExt if ref $fileType eq 'ARRAY';
1546	}
1547	return $fileType;
1548	}
1549
1550	#------------------------------------------------------------------------------
1551	# Return true if we can write the specified file type
1552	# Inputs: 0) file name or ext,
1553	# Returns: true if writable, 0 if not writable, undef if unrecognized
1554	# Note: This will return true for some TIFF-based RAW images which we shouldn't really write
1555	sub CanWrite($)
1556	{
1557	local $_;
1558	my $file = shift or return undef;
1559	my $type = GetFileType($file) or return undef;
1560	return scalar(grep /^$type$/, @writeTypes);
1561	}
1562
1563	#------------------------------------------------------------------------------
1564	# Return true if we can create the specified file type
1565	# Inputs: 0) file name or ext,
1566	# Returns: true if creatable, 0 if not writable, undef if unrecognized
1567	sub CanCreate($)
1568	{
1569	local $_;
1570	my $file = shift or return undef;
1571	my $type = GetFileType($file) or return undef;
1572	return scalar(grep /^$type$/, @createTypes);
1573	}
1574
1575	#==============================================================================
1576	# Functions below this are not part of the public API
1577
1578	# Initialize member variables
1579	# Inputs: 0) ExifTool object reference
1580	sub Init($)
1581	{
1582	local $_;
1583	my $self = shift;
1584	# delete all DataMember variables (lower-case names)
1585	foreach (keys %$self) {
1586	/[a-z]/ and delete $self->{$_};
1587	}
1588	delete $self->{FOUND_TAGS}; # list of found tags
1589	delete $self->{EXIF_DATA}; # the EXIF data block
1590	delete $self->{EXIF_POS}; # EXIF position in file
1591	delete $self->{FIRST_EXIF_POS}; # position of first EXIF in file
1592	delete $self->{EXIF_BYTE_ORDER};# the EXIF byte ordering
1593	delete $self->{HTML_DUMP}; # html dump information
1594	$self->{BASE} = 0; # base for offsets from start of file
1595	$self->{FILE_ORDER} = { }; # hash of tag order in file
1596	$self->{VALUE} = { }; # hash of raw tag values
1597	$self->{TAG_INFO} = { }; # hash of tag information
1598	$self->{GROUP1} = { }; # hash of family 1 group names
1599	$self->{PRIORITY} = { }; # priority of current tags
1600	$self->{PROCESSED} = { }; # hash of processed directory start positions
1601	$self->{DIR_COUNT} = { }; # count various types of directories
1602	$self->{NUM_FOUND} = 0; # total number of tags found (incl. duplicates)
1603	$self->{CHANGED} = 0; # number of tags changed (writer only)
1604	$self->{INDENT} = ' '; # initial indent for verbose messages
1605	$self->{PRIORITY_DIR} = ''; # the priority directory name
1606	$self->{TIFF_TYPE} = ''; # type of TIFF data (APP1, TIFF, NEF, etc...)
1607	$self->{CameraMake} = ''; # camera make
1608	$self->{CameraModel}= ''; # camera model
1609	$self->{CameraType} = ''; # Olympus camera type
1610	if ($self->Options('HtmlDump')) {
1611	require Image::ExifTool::HtmlDump;
1612	$self->{HTML_DUMP} = new Image::ExifTool::HtmlDump;
1613	}
1614	# make sure our TextOut is a file reference
1615	$self->{OPTIONS}->{TextOut} = \*STDOUT unless ref $self->{OPTIONS}->{TextOut};
1616	}
1617
1618	#------------------------------------------------------------------------------
1619	# Parse function arguments and set member variables accordingly
1620	# Inputs: Same as ImageInfo()
1621	# - sets REQUESTED_TAGS, REQ_TAG_LOOKUP, IO_TAG_LIST, FILENAME, RAF, OPTIONS
1622	sub ParseArguments($;@)
1623	{
1624	my $self = shift;
1625	my $options = $self->{OPTIONS};
1626	my @exclude;
1627	my @oldGroupOpts = grep /^Group/, keys %{$self->{OPTIONS}};
1628	my $wasExcludeOpt;
1629
1630	$self->{REQUESTED_TAGS} = [ ];
1631	$self->{REQ_TAG_LOOKUP} = { };
1632	$self->{IO_TAG_LIST} = undef;
1633
1634	# handle our input arguments
1635	while (@_) {
1636	my $arg = shift;
1637	if (ref $arg) {
1638	if (ref $arg eq 'ARRAY') {
1639	$self->{IO_TAG_LIST} = $arg;
1640	foreach (@$arg) {
1641	if (/^-(.*)/) {
1642	push @exclude, $1;
1643	} else {
1644	push @{$self->{REQUESTED_TAGS}}, $_;
1645	}
1646	}
1647	} elsif (ref $arg eq 'HASH') {
1648	my $opt;
1649	foreach $opt (keys %$arg) {
1650	# a single new group option overrides all old group options
1651	if (@oldGroupOpts and $opt =~ /^Group/) {
1652	foreach (@oldGroupOpts) {
1653	delete $options->{$_};
1654	}
1655	undef @oldGroupOpts;
1656	}
1657	$options->{$opt} = $$arg{$opt};
1658	$opt eq 'Exclude' and $wasExcludeOpt = 1;
1659	}
1660	} elsif (ref $arg eq 'SCALAR' or UNIVERSAL::isa($arg,'GLOB')) {
1661	next if defined $self->{RAF};
1662	# convert image data from UTF-8 to character stream if necessary
1663	# (patches RHEL 3 UTF8 LANG problem)
1664	if (ref $arg eq 'SCALAR' and eval 'require Encode; Encode::is_utf8($$arg)') {
1665	my $buff = pack('C', unpack('U0U', $$arg));
1666	$arg = \$buff;
1667	}
1668	$self->{RAF} = new File::RandomAccess($arg);
1669	# set filename to empty string to indicate that
1670	# we have a file but we didn't open it
1671	$self->{FILENAME} = '';
1672	} else {
1673	warn "Don't understand ImageInfo argument $arg\n";
1674	}
1675	} elsif (defined $self->{FILENAME}) {
1676	if ($arg =~ /^-(.*)/) {
1677	push @exclude, $1;
1678	} else {
1679	push @{$self->{REQUESTED_TAGS}}, $arg;
1680	}
1681	} else {
1682	$self->{FILENAME} = $arg;
1683	}
1684	}
1685	# expand shortcuts in tag arguments if provided
1686	if (@{$self->{REQUESTED_TAGS}}) {
1687	ExpandShortcuts($self->{REQUESTED_TAGS});
1688	# initialize lookup for requested tags
1689	foreach (@{$self->{REQUESTED_TAGS}}) {
1690	$self->{REQ_TAG_LOOKUP}->{lc(/.+?:(.+)/ ? $1 : $_)} = 1;
1691	}
1692	}
1693
1694	if (@exclude or $wasExcludeOpt) {
1695	# must add existing excluded tags
1696	if ($options->{Exclude}) {
1697	if (ref $options->{Exclude} eq 'ARRAY') {
1698	push @exclude, @{$options->{Exclude}};
1699	} else {
1700	push @exclude, $options->{Exclude};
1701	}
1702	}
1703	$options->{Exclude} = \@exclude;
1704	# expand shortcuts in new exclude list
1705	ExpandShortcuts($options->{Exclude});
1706	}
1707	}
1708
1709	#------------------------------------------------------------------------------
1710	# Set list of found tags
1711	# Inputs: 0) ExifTool object reference
1712	# Returns: Reference to found tags list (in order of requested tags)
1713	sub SetFoundTags($)
1714	{
1715	my $self = shift;
1716	my $options = $self->{OPTIONS};
1717	my $reqTags = $self->{REQUESTED_TAGS} \|\| [ ];
1718	my $duplicates = $options->{Duplicates};
1719	my $exclude = $options->{Exclude};
1720	my $fileOrder = $self->{FILE_ORDER};
1721	my @groupOptions = sort grep /^Group/, keys %$options;
1722	my $doDups = $duplicates \|\| $exclude \|\| @groupOptions;
1723	my ($tag, $rtnTags);
1724
1725	# only return requested tags if specified
1726	if (@$reqTags) {
1727	$rtnTags or $rtnTags = [ ];
1728	# scan through the requested tags and generate a list of tags we found
1729	my $tagHash = $self->{VALUE};
1730	my $reqTag;
1731	foreach $reqTag (@$reqTags) {
1732	my (@matches, $group, $family, $allGrp, $allTag);
1733	if ($reqTag =~ /^(\d+)?(.+?):(.+)/) {
1734	($family, $group, $tag) = ($1, $2, $3);
1735	$allGrp = 1 if $group =~ /^(\*\|all)$/i;
1736	$family = -1 unless defined $family;
1737	} else {
1738	$tag = $reqTag;
1739	$family = -1;
1740	}
1741	if (defined $tagHash->{$reqTag} and not $doDups) {
1742	$matches[0] = $tag;
1743	} elsif ($tag =~ /^(\*\|all)$/i) {
1744	# tag name of '*' or 'all' matches all tags
1745	if ($doDups or $allGrp) {
1746	@matches = keys %$tagHash;
1747	} else {
1748	@matches = grep(!/ /, keys %$tagHash);
1749	}
1750	next unless @matches; # don't want entry in list for '*' tag
1751	$allTag = 1;
1752	} elsif ($doDups or defined $group) {
1753	# must also look for tags like "Tag (1)"
1754	@matches = grep(/^$tag(\s\|$)/i, keys %$tagHash);
1755	} else {
1756	# find first matching value
1757	# (use in list context to return value instead of count)
1758	($matches[0]) = grep /^$tag$/i, keys %$tagHash;
1759	defined $matches[0] or undef @matches;
1760	}
1761	if (defined $group and not $allGrp) {
1762	# keep only specified group
1763	my @grpMatches;
1764	foreach (@matches) {
1765	my @groups = $self->GetGroup($_, $family);
1766	next unless grep /^$group$/i, @groups;
1767	push @grpMatches, $_;
1768	}
1769	@matches = @grpMatches;
1770	next unless @matches or not $allTag;
1771	}
1772	if (@matches > 1) {
1773	# maintain original file order for multiple tags
1774	@matches = sort { $$fileOrder{$a} <=> $$fileOrder{$b} } @matches;
1775	# return only the highest priority tag unless duplicates wanted
1776	unless ($doDups or $allTag or $allGrp) {
1777	$tag = shift @matches;
1778	my $oldPriority = $self->{PRIORITY}->{$tag} \|\| 1;
1779	foreach (@matches) {
1780	my $priority = $self->{PRIORITY}->{$_};
1781	$priority = 1 unless defined $priority;
1782	next unless $priority >= $oldPriority;
1783	$tag = $_;
1784	$oldPriority = $priority \|\| 1;
1785	}
1786	@matches = ( $tag );
1787	}
1788	} elsif (not @matches) {
1789	# put entry in return list even without value (value is undef)
1790	$matches[0] = "$tag (0)";
1791	# bogus file order entry to avoid warning if sorting in file order
1792	$self->{FILE_ORDER}->{$matches[0]} = 999;
1793	}
1794	push @$rtnTags, @matches;
1795	}
1796	} else {
1797	# no requested tags, so we want all tags
1798	my @allTags;
1799	if ($doDups) {
1800	@allTags = keys %{$self->{VALUE}};
1801	} else {
1802	foreach (keys %{$self->{VALUE}}) {
1803	# only include tag if it doesn't end in a copy number
1804	push @allTags, $_ unless / /;
1805	}
1806	}
1807	$rtnTags = \@allTags;
1808	}
1809
1810	# filter excluded tags and group options
1811	while (($exclude or @groupOptions) and @$rtnTags) {
1812	if ($exclude) {
1813	my @filteredTags;
1814	EX_TAG: foreach $tag (@$rtnTags) {
1815	my $tagName = GetTagName($tag);
1816	my @matches = grep /(^\|:)($tagName\|\*\|all)$/i, @$exclude;
1817	foreach (@matches) {
1818	next EX_TAG unless /^(\d+)?(.+?):/;
1819	my ($family, $group) = ($1, $2);
1820	next EX_TAG if $group =~ /^(\*\|all)$/i;
1821	$family = -1 unless defined $family;
1822	my @groups = $self->GetGroup($tag, $family);
1823	next EX_TAG if grep /^$group$/i, @groups;
1824	}
1825	push @filteredTags, $tag;
1826	}
1827	$rtnTags = \@filteredTags; # use new filtered tag list
1828	last if $duplicates and not @groupOptions;
1829	}
1830	# filter groups if requested, or to remove duplicates
1831	my (%keepTags, %wantGroup, $family, $groupOpt);
1832	my $allGroups = 1;
1833	# build hash of requested/excluded group names for each group family
1834	my $wantOrder = 0;
1835	foreach $groupOpt (@groupOptions) {
1836	$groupOpt =~ /^Group(\d*)/ or next;
1837	$family = $1 \|\| 0;
1838	$wantGroup{$family} or $wantGroup{$family} = { };
1839	my $groupList;
1840	if (ref $options->{$groupOpt} eq 'ARRAY') {
1841	$groupList = $options->{$groupOpt};
1842	} else {
1843	$groupList = [ $options->{$groupOpt} ];
1844	}
1845	foreach (@$groupList) {
1846	# groups have priority in order they were specified
1847	++$wantOrder;
1848	my ($groupName, $want);
1849	if (/^-(.*)/) {
1850	# excluded group begins with '-'
1851	$groupName = $1;
1852	$want = 0; # we don't want tags in this group
1853	} else {
1854	$groupName = $_;
1855	$want = $wantOrder; # we want tags in this group
1856	$allGroups = 0; # don't want all groups if we requested one
1857	}
1858	$wantGroup{$family}->{$groupName} = $want;
1859	}
1860	}
1861	# loop through all tags and decide which ones we want
1862	my (@tags, %bestTag);
1863	GR_TAG: foreach $tag (@$rtnTags) {
1864	my $wantTag = $allGroups; # want tag by default if want all groups
1865	foreach $family (keys %wantGroup) {
1866	my $group = $self->GetGroup($tag, $family);
1867	my $wanted = $wantGroup{$family}->{$group};
1868	next unless defined $wanted;
1869	next GR_TAG unless $wanted; # skip tag if group excluded
1870	# take lowest non-zero want flag
1871	next if $wantTag and $wantTag < $wanted;
1872	$wantTag = $wanted;
1873	}
1874	next unless $wantTag;
1875	if ($duplicates) {
1876	push @tags, $tag;
1877	} else {
1878	my $tagName = GetTagName($tag);
1879	my $bestTag = $bestTag{$tagName};
1880	if (defined $bestTag) {
1881	next if $wantTag > $keepTags{$bestTag};
1882	if ($wantTag == $keepTags{$bestTag}) {
1883	# want two tags with the same name -- keep the latest one
1884	if ($tag =~ / \((\d+)\)$/) {
1885	my $tagNum = $1;
1886	next if $bestTag !~ / \((\d+)\)$/ or $1 > $tagNum;
1887	}
1888	}
1889	# this tag is better, so delete old best tag
1890	delete $keepTags{$bestTag};
1891	}
1892	$keepTags{$tag} = $wantTag; # keep this tag (for now...)
1893	$bestTag{$tagName} = $tag; # this is our current best tag
1894	}
1895	}
1896	unless ($duplicates) {
1897	# construct new tag list with no duplicates, preserving order
1898	foreach $tag (@$rtnTags) {
1899	push @tags, $tag if $keepTags{$tag};
1900	}
1901	}
1902	$rtnTags = \@tags;
1903	last;
1904	}
1905
1906	# save found tags and return reference
1907	return $self->{FOUND_TAGS} = $rtnTags;
1908	}
1909
1910	#------------------------------------------------------------------------------
1911	# Utility to load our write routines if required (called via AUTOLOAD)
1912	# Inputs: 0) autoload function, 1-N) function arguments
1913	# Returns: result of function or dies if function not available
1914	# To Do: Generalize this routine so it works on systems that don't use '/'
1915	# as a path name separator.
1916	sub DoAutoLoad(@)
1917	{
1918	my $autoload = shift;
1919	my @callInfo = split(/::/, $autoload);
1920	my $file = 'Image/ExifTool/Write';
1921
1922	return if $callInfo[$#callInfo] eq 'DESTROY';
1923	if (@callInfo == 4) {
1924	# load Image/ExifTool/WriteMODULE.pl
1925	$file .= "$callInfo[2].pl";
1926	} else {
1927	# load Image/ExifTool/Writer.pl
1928	$file .= 'r.pl';
1929	}
1930	# attempt to load the package
1931	eval "require '$file'" or die "Error while attempting to call $autoload\n$@\n";
1932	unless (defined &$autoload) {
1933	my @caller = caller(0);
1934	# reproduce Perl's standard 'undefined subroutine' message:
1935	die "Undefined subroutine $autoload called at $caller[1] line $caller[2]\n";
1936	}
1937	no strict 'refs';
1938	return &$autoload(@_); # call the function
1939	}
1940
1941	#------------------------------------------------------------------------------
1942	# AutoLoad our writer routines when necessary
1943	#
1944	sub AUTOLOAD
1945	{
1946	return DoAutoLoad($AUTOLOAD, @_);
1947	}
1948
1949	#------------------------------------------------------------------------------
1950	# Add warning tag
1951	# Inputs: 0) ExifTool object reference, 1) warning message, 2) true if minor
1952	# Returns: true if warning tag was added
1953	sub Warn($$;$)
1954	{
1955	my ($self, $str, $ignorable) = @_;
1956	if ($ignorable) {
1957	return 0 if $self->{OPTIONS}->{IgnoreMinorErrors};
1958	$str = "[minor] $str";
1959	}
1960	$self->FoundTag('Warning', $str);
1961	return 1;
1962	}
1963
1964	#------------------------------------------------------------------------------
1965	# Add error tag
1966	# Inputs: 0) ExifTool object reference, 1) error message, 2) true if minor
1967	# Returns: true if error tag was added, otherwise warning was added
1968	sub Error($$;$)
1969	{
1970	my ($self, $str, $ignorable) = @_;
1971	if ($ignorable) {
1972	if ($self->{OPTIONS}->{IgnoreMinorErrors}) {
1973	$self->Warn($str);
1974	return 0;
1975	}
1976	$str = "[minor] $str";
1977	}
1978	$self->FoundTag('Error', $str);
1979	return 1;
1980	}
1981
1982	#------------------------------------------------------------------------------
1983	# Expand shortcuts
1984	# Inputs: 0) reference to list of tags
1985	# Notes: Handles leading '-' for excluded tags, group names, and redirected tags
1986	sub ExpandShortcuts($)
1987	{
1988	my $tagList = shift \|\| return;
1989
1990	require Image::ExifTool::Shortcuts;
1991
1992	# expand shortcuts
1993	my @expandedTags;
1994	my ($entry, $tag, $excl);
1995	foreach $entry (@$tagList) {
1996	# remove leading '-'
1997	($excl, $tag) = $entry =~ /^(-?)(.*)/s;
1998	my ($post, @post);
1999	# handle redirection
2000	if ($tag =~ /(.+?)([-+]?[<>].+)/s and not $excl) {
2001	($tag, $post) = ($1, $2);
2002	if ($post =~ /^[-+]?>/ or $post !~ /\$/) {
2003	# expand shortcuts in postfix (rhs of redirection)
2004	my ($op, $p2, $t2) = ($post =~ /([-+]?[<>])(.+?:)?(.+)/);
2005	$p2 = '' unless defined $p2;
2006	my ($match) = grep /^\Q$t2\E$/i, keys %Image::ExifTool::Shortcuts::Main;
2007	if ($match) {
2008	foreach (@{$Image::ExifTool::Shortcuts::Main{$match}}) {
2009	/^-/ and next; # ignore excluded tags
2010	if ($p2 and /(.+?:)(.+)/) {
2011	push @post, "$op$_";
2012	} else {
2013	push @post, "$op$p2$_";
2014	}
2015	}
2016	next unless @post;
2017	$post = shift @post;
2018	}
2019	}
2020	} else {
2021	$post = '';
2022	}
2023	# handle group names
2024	my $pre;
2025	if ($tag =~ /(.+?:)(.+)/) {
2026	($pre, $tag) = ($1, $2);
2027	} else {
2028	$pre = '';
2029	}
2030	# loop over all postfixes
2031	for (;;) {
2032	# expand the tag name
2033	my ($match) = grep /^\Q$tag\E$/i, keys %Image::ExifTool::Shortcuts::Main;
2034	if ($match) {
2035	if ($excl) {
2036	# entry starts with '-', so exclude all tags in this shortcut
2037	foreach (@{$Image::ExifTool::Shortcuts::Main{$match}}) {
2038	/^-/ and next; # ignore excluded exclude tags
2039	# group of expanded tag takes precedence
2040	if ($pre and /(.+?:)(.+)/) {
2041	push @expandedTags, "$excl$_";
2042	} else {
2043	push @expandedTags, "$excl$pre$_";
2044	}
2045	}
2046	} elsif (length $pre or length $post) {
2047	foreach (@{$Image::ExifTool::Shortcuts::Main{$match}}) {
2048	/(-?)(.+?:)?(.+)/;
2049	if ($2) {
2050	# group from expanded tag takes precedence
2051	push @expandedTags, "$_$post";
2052	} else {
2053	push @expandedTags, "$1$pre$3$post";
2054	}
2055	}
2056	} else {
2057	push @expandedTags, @{$Image::ExifTool::Shortcuts::Main{$match}};
2058	}
2059	} else {
2060	push @expandedTags, "$excl$pre$tag$post";
2061	}
2062	last unless @post;
2063	$post = shift @post;
2064	}
2065	}
2066	@$tagList = @expandedTags;
2067	}
2068
2069	#------------------------------------------------------------------------------
2070	# Add hash of composite tags to our composites
2071	# Inputs: 0) hash reference to table of composite tags to add or module name,
2072	# 1) overwrite existing tag
2073	sub AddCompositeTags($;$)
2074	{
2075	local $_;
2076	my ($add, $overwrite) = @_;
2077	my $module;
2078	unless (ref $add) {
2079	$module = $add;
2080	$add .= '::Composite';
2081	no strict 'refs';
2082	$add = \%$add;
2083	}
2084	my $defaultGroups = $$add{GROUPS};
2085
2086	# make sure default groups are defined in families 0 and 1
2087	if ($defaultGroups) {
2088	$defaultGroups->{0} or $defaultGroups->{0} = 'Composite';
2089	$defaultGroups->{1} or $defaultGroups->{1} = 'Composite';
2090	$defaultGroups->{2} or $defaultGroups->{2} = 'Other';
2091	} else {
2092	$defaultGroups = $$add{GROUPS} = { 0 => 'Composite', 1 => 'Composite', 2 => 'Other' };
2093	}
2094	SetupTagTable($add);
2095	my $tagID;
2096	foreach $tagID (keys %$add) {
2097	next if $specialTags{$tagID}; # must skip special tags
2098	my $tagInfo = $$add{$tagID};
2099	# tagID's MUST be the exact tag name for logic in BuildCompositeTags()
2100	my $tag = $$tagInfo{Name};
2101	$$tagInfo{Module} = $module if $$tagInfo{Writable};
2102	# allow composite tags with the same name
2103	my ($t, $n, $type);
2104	while ($Image::ExifTool::Composite{$tag} and not $overwrite) {
2105	$n ? $n += 1 : $n = 2, $t = $tag;
2106	$tag = "${t}_$n";
2107	}
2108	# convert scalar Require/Desire entries
2109	foreach $type ('Require','Desire') {
2110	my $req = $$tagInfo{$type} or next;
2111	$$tagInfo{$type} = { 0 => $req } if ref($req) ne 'HASH';
2112	}
2113	# add this composite tag to our main composite table
2114	$$tagInfo{Table} = \%Image::ExifTool::Composite;
2115	$Image::ExifTool::Composite{$tag} = $tagInfo;
2116	# set all default groups in tag
2117	my $groups = $$tagInfo{Groups};
2118	$groups or $groups = $$tagInfo{Groups} = { };
2119	# fill in default groups
2120	foreach (keys %$defaultGroups) {
2121	$$groups{$_} or $$groups{$_} = $$defaultGroups{$_};
2122	}
2123	# set flag indicating group list was built
2124	$$tagInfo{GotGroups} = 1;
2125	}
2126	}
2127
2128	#------------------------------------------------------------------------------
2129	# Expand tagInfo Flags
2130	# Inputs: 0) tagInfo hash ref
2131	# Notes: $$tagInfo{Flags} must be defined to call this routine
2132	sub ExpandFlags($)
2133	{
2134	my $tagInfo = shift;
2135	my $flags = $$tagInfo{Flags};
2136	if (ref $flags eq 'ARRAY') {
2137	foreach (@$flags) {
2138	$$tagInfo{$_} = 1;
2139	}
2140	} elsif (ref $flags eq 'HASH') {
2141	my $key;
2142	foreach $key (keys %$flags) {
2143	$$tagInfo{$key} = $$flags{$key};
2144	}
2145	} else {
2146	$$tagInfo{$flags} = 1;
2147	}
2148	}
2149
2150	#------------------------------------------------------------------------------
2151	# Set up tag table (must be done once for each tag table used)
2152	# Inputs: 0) Reference to tag table
2153	# Notes: - generates 'Name' field from key if it doesn't exist
2154	# - stores 'Table' pointer
2155	# - expands 'Flags' for quick lookup
2156	sub SetupTagTable($)
2157	{
2158	my $tagTablePtr = shift;
2159	my $tagID;
2160	foreach $tagID (TagTableKeys($tagTablePtr)) {
2161	my @infoArray = GetTagInfoList($tagTablePtr,$tagID);
2162	# process conditional tagInfo arrays
2163	my $tagInfo;
2164	foreach $tagInfo (@infoArray) {
2165	$$tagInfo{Table} = $tagTablePtr;
2166	my $tag = $$tagInfo{Name};
2167	unless (defined $tag) {
2168	# generate name equal to tag ID if 'Name' doesn't exist
2169	$tag = $tagID;
2170	$$tagInfo{Name} = ucfirst($tag); # make first char uppercase
2171	}
2172	$$tagInfo{Flags} and ExpandFlags($tagInfo);
2173	}
2174	}
2175	}
2176
2177	#------------------------------------------------------------------------------
2178	# Utilities to check for numerical types
2179	# Inputs: 0) value; Returns: true if value is a numerical type
2180	# Notes: May change commas to decimals in floats for use in other locales
2181	sub IsFloat($) {
2182	return 1 if $_[0] =~ /^([+-]?)(?=\d\|\.\d)\d(\.\d)?([Ee]([+-]?\d+))?$/;
2183	# allow comma separators (for other locales)
2184	return 0 unless $_[0] =~ /^([+-]?)(?=\d\|,\d)\d(,\d)?([Ee]([+-]?\d+))?$/;
2185	$_[0] =~ tr/,/./; # but translate ',' to '.'
2186	return 1;
2187	}
2188	sub IsInt($) { return scalar($_[0] =~ /^[+-]?\d+$/); }
2189	sub IsHex($) { return scalar($_[0] =~ /^(0x)?[0-9a-f]{1,8}$/i); }
2190
2191	# round floating point value to specified number of significant digits
2192	# Inputs: 0) value, 1) number of sig digits; Returns: rounded number
2193	sub RoundFloat($$)
2194	{
2195	my ($val, $sig) = @_;
2196	$val == 0 and return 0;
2197	my $sign = $val < 0 ? ($val=-$val, -1) : 1;
2198	my $log = log($val) / log(10);
2199	my $exp = int($log) - $sig + ($log > 0 ? 1 : 0);
2200	return $sign * int(10 ** ($log - $exp) + 0.5) * 10 ** $exp;
2201	}
2202
2203	#------------------------------------------------------------------------------
2204	# Utility routines to for reading binary data values from file
2205
2206	my $swapBytes; # set if EXIF header is not native byte ordering
2207	my $swapWords; # swap 32-bit words in doubles (ARM quirk)
2208	my $currentByteOrder = 'MM'; # current byte ordering ('II' or 'MM')
2209	my %unpackMotorola = ( S => 'n', L => 'N', C => 'C', c => 'c' );
2210	my %unpackIntel = ( S => 'v', L => 'V', C => 'C', c => 'c' );
2211	my %unpackStd = %unpackMotorola;
2212
2213	# Swap bytes in data if necessary
2214	# Inputs: 0) data, 1) number of bytes
2215	# Returns: swapped data
2216	sub SwapBytes($$)
2217	{
2218	return $_[0] unless $swapBytes;
2219	my ($val, $bytes) = @_;
2220	my $newVal = '';
2221	$newVal .= substr($val, $bytes, 1) while $bytes--;
2222	return $newVal;
2223	}
2224	# Swap words. Inputs: 8 bytes of data, Returns: swapped data
2225	sub SwapWords($)
2226	{
2227	return $_[0] unless $swapWords and length($_[0]) == 8;
2228	return substr($_[0],4,4) . substr($_[0],0,4)
2229	}
2230
2231	# Unpack value, letting unpack() handle byte swapping
2232	# Inputs: 0) unpack template, 1) data reference, 2) offset
2233	# Returns: unpacked number
2234	# - uses value of %unpackStd to determine the unpack template
2235	# - can only be called for 'S' or 'L' templates since these are the only
2236	# templates for which you can specify the byte ordering.
2237	sub DoUnpackStd(@)
2238	{
2239	$_[2] and return unpack("x$_[2] $unpackStd{$_[0]}", ${$_[1]});
2240	return unpack($unpackStd{$_[0]}, ${$_[1]});
2241	}
2242	# Pack value
2243	# Inputs: 0) template, 1) value, 2) data ref (or undef), 3) offset (if data ref)
2244	# Returns: packed value
2245	sub DoPackStd(@)
2246	{
2247	my $val = pack($unpackStd{$_[0]}, $_[1]);
2248	$_[2] and substr(${$_[2]}, $_[3], length($val)) = $val;
2249	return $val;
2250	}
2251
2252	# Unpack value, handling the byte swapping manually
2253	# Inputs: 0) # bytes, 1) unpack template, 2) data reference, 3) offset
2254	# Returns: unpacked number
2255	# - uses value of $swapBytes to determine byte ordering
2256	sub DoUnpack(@)
2257	{
2258	my ($bytes, $template, $dataPt, $pos) = @_;
2259	my $val;
2260	if ($swapBytes) {
2261	$val = '';
2262	$val .= substr($$dataPt,$pos+$bytes,1) while $bytes--;
2263	} else {
2264	$val = substr($$dataPt,$pos,$bytes);
2265	}
2266	defined($val) or return undef;
2267	return unpack($template,$val);
2268	}
2269
2270	# Unpack double value
2271	# Inputs: 0) unpack template, 1) data reference, 2) offset
2272	# Returns: unpacked number
2273	sub DoUnpackDbl(@)
2274	{
2275	my ($template, $dataPt, $pos) = @_;
2276	my $val = substr($$dataPt,$pos,8);
2277	defined($val) or return undef;
2278	# swap bytes and 32-bit words (ARM quirk) if necessary, then unpack value
2279	return unpack($template, SwapWords(SwapBytes($val, 8)));
2280	}
2281
2282	# Inputs: 0) data reference, 1) offset into data
2283	sub Get8s($$) { return DoUnpackStd('c', @_); }
2284	sub Get8u($$) { return DoUnpackStd('C', @_); }
2285	sub Get16s($$) { return DoUnpack(2, 's', @_); }
2286	sub Get16u($$) { return DoUnpackStd('S', @_); }
2287	sub Get32s($$) { return DoUnpack(4, 'l', @_); }
2288	sub Get32u($$) { return DoUnpackStd('L', @_); }
2289	sub GetFloat($$) { return DoUnpack(4, 'f', @_); }
2290	sub GetDouble($$) { return DoUnpackDbl('d', @_); }
2291
2292	sub GetRational32s($$)
2293	{
2294	my ($dataPt, $pos) = @_;
2295	my $denom = Get16s($dataPt, $pos + 2) or return 'inf';
2296	# round off to a reasonable number of significant figures
2297	return RoundFloat(Get16s($dataPt,$pos) / $denom, 7);
2298	}
2299	sub GetRational32u($$)
2300	{
2301	my ($dataPt, $pos) = @_;
2302	my $denom = Get16u($dataPt, $pos + 2) or return 'inf';
2303	return RoundFloat(Get16u($dataPt,$pos) / $denom, 7);
2304	}
2305	sub GetRational64s($$)
2306	{
2307	my ($dataPt, $pos) = @_;
2308	my $denom = Get32s($dataPt, $pos + 4) or return 'inf';
2309	return RoundFloat(Get32s($dataPt,$pos) / $denom, 10);
2310	}
2311	sub GetRational64u($$)
2312	{
2313	my ($dataPt, $pos) = @_;
2314	my $denom = Get32u($dataPt, $pos + 4) or return 'inf';
2315	return RoundFloat(Get32u($dataPt,$pos) / $denom, 10);
2316	}
2317	sub GetFixed16s($$)
2318	{
2319	my ($dataPt, $pos) = @_;
2320	my $val = Get16s($dataPt, $pos) / 0x100;
2321	return int($val * 1000 + ($val<0 ? -0.5 : 0.5)) / 1000;
2322	}
2323	sub GetFixed16u($$)
2324	{
2325	my ($dataPt, $pos) = @_;
2326	return int((Get16u($dataPt, $pos) / 0x100) * 1000 + 0.5) / 1000;
2327	}
2328	sub GetFixed32s($$)
2329	{
2330	my ($dataPt, $pos) = @_;
2331	my $val = Get32s($dataPt, $pos) / 0x10000;
2332	# remove insignificant digits
2333	return int($val * 1e5 + ($val>0 ? 0.5 : -0.5)) / 1e5;
2334	}
2335	sub GetFixed32u($$)
2336	{
2337	my ($dataPt, $pos) = @_;
2338	# remove insignificant digits
2339	return int((Get32u($dataPt, $pos) / 0x10000) * 1e5 + 0.5) / 1e5;
2340	}
2341	# Inputs: 0) value, 1) data ref, 2) offset
2342	sub Set8s(@) { return DoPackStd('c', @_); }
2343	sub Set8u(@) { return DoPackStd('C', @_); }
2344	sub Set16u(@) { return DoPackStd('S', @_); }
2345	sub Set32u(@) { return DoPackStd('L', @_); }
2346
2347	#------------------------------------------------------------------------------
2348	# Get current byte order ('II' or 'MM')
2349	sub GetByteOrder() { return $currentByteOrder; }
2350
2351	#------------------------------------------------------------------------------
2352	# Set byte ordering
2353	# Inputs: 0) 'II'=intel, 'MM'=motorola
2354	# Returns: 1 on success
2355	sub SetByteOrder($)
2356	{
2357	my $order = shift;
2358
2359	if ($order eq 'MM') { # big endian (Motorola)
2360	%unpackStd = %unpackMotorola;
2361	} elsif ($order eq 'II') { # little endian (Intel)
2362	%unpackStd = %unpackIntel;
2363	} else {
2364	return 0;
2365	}
2366	my $val = unpack('S','A ');
2367	my $nativeOrder;
2368	if ($val == 0x4120) { # big endian
2369	$nativeOrder = 'MM';
2370	} elsif ($val == 0x2041) { # little endian
2371	$nativeOrder = 'II';
2372	} else {
2373	warn sprintf("Unknown native byte order! (pattern %x)\n",$val);
2374	return 0;
2375	}
2376	$currentByteOrder = $order; # save current byte order
2377
2378	# swap bytes if our native CPU byte ordering is not the same as the EXIF
2379	$swapBytes = ($order ne $nativeOrder);
2380
2381	# little-endian ARM has big-endian words for doubles (thanks Riku Voipio)
2382	# (Note: Riku's patch checked for '0ff3', but I think it should be 'f03f' since
2383	# 1 is '000000000000f03f' on an x86 -- so check for both, but which is correct?)
2384	my $pack1d = pack('d', 1);
2385	$swapWords = ($pack1d eq "\0\0\x0f\xf3\0\0\0\0" or
2386	$pack1d eq "\0\0\xf0\x3f\0\0\0\0");
2387	return 1;
2388	}
2389
2390	#------------------------------------------------------------------------------
2391	# Change byte order
2392	sub ToggleByteOrder()
2393	{
2394	SetByteOrder(GetByteOrder() eq 'II' ? 'MM' : 'II');
2395	}
2396
2397	#------------------------------------------------------------------------------
2398	# hash lookups for reading values from data
2399	my %formatSize = (
2400	int8s => 1,
2401	int8u => 1,
2402	int16s => 2,
2403	int16u => 2,
2404	int32s => 4,
2405	int32u => 4,
2406	int64s => 8,
2407	int64u => 8,
2408	rational32s => 4,
2409	rational32u => 4,
2410	rational64s => 8,
2411	rational64u => 8,
2412	fixed16s => 2,
2413	fixed16u => 2,
2414	fixed32s => 4,
2415	fixed32u => 4,
2416	float => 4,
2417	double => 8,
2418	extended => 10,
2419	string => 1,
2420	binary => 1,
2421	'undef' => 1,
2422	ifd => 4,
2423	ifd8 => 8,
2424	);
2425	my %readValueProc = (
2426	int8s => \&Get8s,
2427	int8u => \&Get8u,
2428	int16s => \&Get16s,
2429	int16u => \&Get16u,
2430	int32s => \&Get32s,
2431	int32u => \&Get32u,
2432	int64s => \&Get64s,
2433	int64u => \&Get64u,
2434	rational32s => \&GetRational32s,
2435	rational32u => \&GetRational32u,
2436	rational64s => \&GetRational64s,
2437	rational64u => \&GetRational64u,
2438	fixed16s => \&GetFixed16s,
2439	fixed16u => \&GetFixed16u,
2440	fixed32s => \&GetFixed32s,
2441	fixed32u => \&GetFixed32u,
2442	float => \&GetFloat,
2443	double => \&GetDouble,
2444	extended => \&GetExtended,
2445	ifd => \&Get32u,
2446	ifd8 => \&Get64u,
2447	);
2448	sub FormatSize($) { return $formatSize{$_[0]}; }
2449
2450	#------------------------------------------------------------------------------
2451	# Read value from binary data (with current byte ordering)
2452	# Inputs: 0) data reference, 1) value offset, 2) format string,
2453	# 3) number of values (or undef to use all data)
2454	# 4) valid data length relative to offset
2455	# Returns: converted value, or undefined if data isn't there
2456	# or list of values in list context
2457	sub ReadValue($$$$$)
2458	{
2459	my ($dataPt, $offset, $format, $count, $size) = @_;
2460
2461	my $len = $formatSize{$format};
2462	unless ($len) {
2463	warn "Unknown format $format";
2464	$len = 1;
2465	}
2466	unless ($count) {
2467	return '' if defined $count or $size < $len;
2468	$count = int($size / $len);
2469	}
2470	# make sure entry is inside data
2471	if ($len * $count > $size) {
2472	$count = int($size / $len); # shorten count if necessary
2473	$count < 1 and return undef; # return undefined if no data
2474	}
2475	my @vals;
2476	my $proc = $readValueProc{$format};
2477	if ($proc) {
2478	for (;;) {
2479	push @vals, &$proc($dataPt, $offset);
2480	last if --$count <= 0;
2481	$offset += $len;
2482	}
2483	} else {
2484	# handle undef/binary/string
2485	$vals[0] = substr($$dataPt, $offset, $count);
2486	# truncate string at null terminator if necessary
2487	$vals[0] =~ s/\0.*//s if $format eq 'string';
2488	}
2489	if (wantarray) {
2490	return @vals;
2491	} elsif (@vals > 1) {
2492	return join(' ', @vals);
2493	} else {
2494	return $vals[0];
2495	}
2496	}
2497
2498	#------------------------------------------------------------------------------
2499	# Convert UTF-8 to current character set
2500	# Inputs: 0) ExifTool ref, 1) UTF-8 string
2501	# Return: Converted string
2502	sub UTF82Charset($$)
2503	{
2504	my ($self, $val) = @_;
2505	if ($self->{OPTIONS}->{Charset} eq 'Latin' and $val =~ /[\x80-\xff]/) {
2506	$val = Image::ExifTool::UTF82Unicode($val,'n',$self);
2507	$val = Image::ExifTool::Unicode2Latin($val,'n',$self);
2508	}
2509	return $val;
2510	}
2511
2512	#------------------------------------------------------------------------------
2513	# Convert Latin to current character set
2514	# Inputs: 0) ExifTool ref, 1) Latin string
2515	# Return: Converted string
2516	sub Latin2Charset($$)
2517	{
2518	my ($self, $val) = @_;
2519	if ($self->{OPTIONS}->{Charset} eq 'UTF8' and $val =~ /[\x80-\xff]/) {
2520	$val = Image::ExifTool::Latin2Unicode($val,'n');
2521	$val = Image::ExifTool::Unicode2UTF8($val,'n');
2522	}
2523	return $val;
2524	}
2525
2526	#------------------------------------------------------------------------------
2527	# Decode bit mask
2528	# Inputs: 0) value to decode, 1) Reference to hash for decoding (or undef)
2529	# 2) optional bits per word (defaults to 32)
2530	sub DecodeBits($$;$)
2531	{
2532	my ($vals, $lookup, $bits) = @_;
2533	$bits or $bits = 32;
2534	my ($val, $i, @bitList);
2535	my $num = 0;
2536	foreach $val (split ' ', $vals) {
2537	for ($i=0; $i<$bits; ++$i) {
2538	next unless $val & (1 << $i);
2539	my $n = $i + $num;
2540	if (not $lookup) {
2541	push @bitList, $n;
2542	} elsif ($$lookup{$n}) {
2543	push @bitList, $$lookup{$n};
2544	} else {
2545	push @bitList, "[$n]";
2546	}
2547	}
2548	$num += $bits;
2549	}
2550	return '(none)' unless @bitList;
2551	return join($lookup ? ', ' : ',', @bitList);
2552	}
2553
2554	#------------------------------------------------------------------------------
2555	# Validate an extracted image and repair if necessary
2556	# Inputs: 0) ExifTool object reference, 1) image reference, 2) tag name
2557	# Returns: image reference or undef if it wasn't valid
2558	sub ValidateImage($$$)
2559	{
2560	my ($self, $imagePt, $tag) = @_;
2561	return undef if $$imagePt eq 'none';
2562	unless ($$imagePt =~ /^(Binary data\|\xff\xd8\xff)/ or
2563	# the first byte of the preview of some Minolta cameras is wrong,
2564	# so check for this and set it back to 0xff if necessary
2565	$$imagePt =~ s/^.(\xd8\xff\xdb)/\xff$1/ or
2566	$self->Options('IgnoreMinorErrors'))
2567	{
2568	# issue warning only if the tag was specifically requested
2569	if ($self->{REQ_TAG_LOOKUP}->{lc($tag)}) {
2570	$self->Warn("$tag is not a valid JPEG image",1);
2571	return undef;
2572	}
2573	}
2574	return $imagePt;
2575	}
2576
2577	#------------------------------------------------------------------------------
2578	# Make description from a tag name
2579	# Inputs: 0) tag name 1) optional tagID to add at end of description
2580	# Returns: description
2581	sub MakeDescription($;$)
2582	{
2583	my ($tag, $tagID) = @_;
2584	# start with the tag name and force first letter to be upper case
2585	my $desc = ucfirst($tag);
2586	$desc =~ tr/_/ /; # translate underlines to spaces
2587	# put a space between lower/UPPER case and lower/number combinations
2588	$desc =~ s/([a-z])([A-Z\d])/$1 $2/g;
2589	# put a space between acronyms and words
2590	$desc =~ s/([A-Z])([A-Z][a-z])/$1 $2/g;
2591	# put spaces after numbers (if more than one character following number)
2592	$desc =~ s/(\d)([A-Z]\S)/$1 $2/g;
2593	# remove space in hex number
2594	$desc =~ s/ 0x ([\dA-Fa-f])/ 0x$1/g;
2595	$desc .= ' ' . $tagID if defined $tagID;
2596	return $desc;
2597	}
2598
2599	#------------------------------------------------------------------------------
2600	# Return printable value
2601	# Inputs: 0) ExifTool object reference
2602	# 1) value to print, 2) true for unlimited line length
2603	sub Printable($;$)
2604	{
2605	my ($self, $outStr, $unlimited) = @_;
2606	return '(undef)' unless defined $outStr;
2607	$outStr =~ tr/\x01-\x1f\x7f-\xff/./;
2608	$outStr =~ s/\x00//g;
2609	# limit length if verbose < 4
2610	if (length($outStr) > 60 and not $unlimited and $self->{OPTIONS}->{Verbose} < 4) {
2611	$outStr = substr($outStr,0,54) . '[snip]';
2612	}
2613	return $outStr;
2614	}
2615
2616	#------------------------------------------------------------------------------
2617	# Convert date/time from Exif format
2618	# Inputs: 0) ExifTool object reference, 1) Date/time in EXIF format
2619	# Returns: Formatted date/time string
2620	sub ConvertDateTime($$)
2621	{
2622	my ($self, $date) = @_;
2623	my $dateFormat = $self->{OPTIONS}->{DateFormat};
2624	# only convert date if a format was specified and the date is recognizable
2625	if ($dateFormat) {
2626	if ($date =~ /^(\d+):(\d+):(\d+)\s+(\d+):(\d+):(\d+)/ and eval 'require POSIX') {
2627	$date = POSIX::strftime($dateFormat, $6, $5, $4, $3, $2-1, $1-1900);
2628	} elsif ($self->{OPTIONS}->{StrictDate}) {
2629	undef $date;
2630	}
2631	}
2632	return $date;
2633	}
2634
2635	#------------------------------------------------------------------------------
2636	# Convert Unix time to EXIF date/time string
2637	# Inputs: 0) Unix time value, 1) non-zero to use local instead of GMT time
2638	# Returns: EXIF date/time string
2639	sub ConvertUnixTime($;$)
2640	{
2641	my $time = shift;
2642	return '0000:00:00 00:00:00' if $time == 0;
2643	my @tm = shift() ? localtime($time) : gmtime($time);
2644	return sprintf("%4d:%.2d:%.2d %.2d:%.2d:%.2d", $tm[5]+1900, $tm[4]+1,
2645	$tm[3], $tm[2], $tm[1], $tm[0]);
2646	}
2647
2648	#------------------------------------------------------------------------------
2649	# Get Unix time from EXIF-formatted date/time string
2650	# Inputs: 0) EXIF date/time string, 1) non-zero to use local instead of GMT time
2651	# Returns: Unix time or undefined on error
2652	sub GetUnixTime($;$)
2653	{
2654	my $timeStr = shift;
2655	return 0 if $timeStr eq '0000:00:00 00:00:00';
2656	my @tm = ($timeStr =~ /^(\d+):(\d+):(\d+)\s+(\d+):(\d+):(\d+)/);
2657	return undef unless @tm == 6;
2658	return undef unless eval 'require Time::Local';
2659	$tm[0] -= 1900; # convert year
2660	$tm[1] -= 1; # convert month
2661	@tm = reverse @tm; # change to order required by timelocal()
2662	return shift() ? Time::Local::timelocal(@tm) : Time::Local::timegm(@tm);
2663	}
2664
2665	#------------------------------------------------------------------------------
2666	# Save information for HTML dump
2667	# Inputs: 0) ExifTool hash ref, 1) start offset, 2) data size
2668	# 3) comment string, 4) tool tip (or SAME), 5) flags
2669	sub HtmlDump($$$$;$$)
2670	{
2671	my $self = shift;
2672	my $pos = shift;
2673	$pos += $$self{BASE} if $$self{BASE};
2674	$$self{HTML_DUMP} and $self->{HTML_DUMP}->Add($pos, @_);
2675	}
2676
2677	#------------------------------------------------------------------------------
2678	# JPEG constants
2679	my %jpegMarker = (
2680	0x01 => 'TEM',
2681	0xc0 => 'SOF0', # to SOF15, with a few exceptions below
2682	0xc4 => 'DHT',
2683	0xc8 => 'JPGA',
2684	0xcc => 'DAC',
2685	0xd0 => 'RST0',
2686	0xd8 => 'SOI',
2687	0xd9 => 'EOI',
2688	0xda => 'SOS',
2689	0xdb => 'DQT',
2690	0xdc => 'DNL',
2691	0xdd => 'DRI',
2692	0xde => 'DHP',
2693	0xdf => 'EXP',
2694	0xe0 => 'APP0', # to APP15
2695	0xf0 => 'JPG0',
2696	0xfe => 'COM',
2697	);
2698
2699	#------------------------------------------------------------------------------
2700	# Get JPEG marker name
2701	# Inputs: 0) Jpeg number
2702	# Returns: marker name
2703	sub JpegMarkerName($)
2704	{
2705	my $marker = shift;
2706	my $markerName = $jpegMarker{$marker};
2707	unless ($markerName) {
2708	$markerName = $jpegMarker{$marker & 0xf0};
2709	if ($markerName and $markerName =~ /^([A-Z]+)\d+$/) {
2710	$markerName = $1 . ($marker & 0x0f);
2711	} else {
2712	$markerName = sprintf("marker 0x%.2x", $marker);
2713	}
2714	}
2715	return $markerName;
2716	}
2717
2718	#------------------------------------------------------------------------------
2719	# Identify trailer ending at specified offset from end of file
2720	# Inputs: 0) RAF reference, 1) offset from end of file (0 by default)
2721	# Returns: Trailer info hash (with RAF and DirName set),
2722	# or undef if no recognized trailer was found
2723	# Notes: leaves file position unchanged
2724	sub IdentifyTrailer($;$)
2725	{
2726	my $raf = shift;
2727	my $offset = shift \|\| 0;
2728	my $pos = $raf->Tell();
2729	my ($buff, $type, $len);
2730	while ($raf->Seek(-$offset, 2) and ($len = $raf->Tell()) > 0) {
2731	# read up to 64 bytes before specified offset from end of file
2732	$len = 64 if $len > 64;
2733	$raf->Seek(-$len, 1) and $raf->Read($buff, $len) == $len or last;
2734	if ($buff =~ /AXS(!\|\*).{8}$/s) {
2735	$type = 'AFCP';
2736	} elsif ($buff =~ /\xa1\xb2\xc3\xd4$/) {
2737	$type = 'FotoStation';
2738	} elsif ($buff =~ /cbipcbbl$/) {
2739	$type = 'PhotoMechanic';
2740	} elsif ($buff =~ /^CANON OPTIONAL DATA\0/) {
2741	$type = 'CanonVRD';
2742	} elsif ($buff =~ /~\0\x04\0zmie~\0\0\x06.{4}[\x10\x18]\x04$/s or
2743	$buff =~ /~\0\x04\0zmie~\0\0\x0a.{8}[\x10\x18]\x08$/s)
2744	{
2745	$type = 'MIE';
2746	}
2747	last;
2748	}
2749	$raf->Seek($pos, 0); # restore original file position
2750	return $type ? { RAF => $raf, DirName => $type } : undef;
2751	}
2752
2753	#------------------------------------------------------------------------------
2754	# Extract EXIF information from a jpg image
2755	# Inputs: 0) ExifTool object reference, 1) dirInfo ref with RAF set
2756	# Returns: 1 on success, 0 if this wasn't a valid JPEG file
2757	sub ProcessJPEG($$)
2758	{
2759	my ($self, $dirInfo) = @_;
2760	my ($ch,$s,$length);
2761	my $verbose = $self->{OPTIONS}->{Verbose};
2762	my $out = $self->{OPTIONS}->{TextOut};
2763	my $raf = $$dirInfo{RAF};
2764	my $htmlDump = $self->{HTML_DUMP};
2765	my %dumpParms = ( Out => $out );
2766	my ($success, $icc_profile, $wantPreview, $trailInfo);
2767
2768	# check to be sure this is a valid JPG file
2769	return 0 unless $raf->Read($s, 2) == 2 and $s eq "\xff\xd8";
2770	$dumpParms{MaxLen} = 128 if $verbose < 4;
2771	$self->SetFileType(); # set FileType tag
2772	if ($htmlDump) {
2773	my $pos = $raf->Tell() - 2;
2774	$self->HtmlDump(0, $pos, '[unknown header]') if $pos;
2775	$self->HtmlDump($pos, 2, 'JPEG header', 'SOI Marker');
2776	}
2777
2778	# set input record separator to 0xff (the JPEG marker) to make reading quicker
2779	my $oldsep = $/;
2780	$/ = "\xff";
2781
2782	my ($nextMarker, $nextSegDataPt, $nextSegPos, $combinedSegData, $dumpEnd);
2783
2784	# read file until we reach an end of image (EOI) or start of scan (SOS)
2785	Marker: for (;;) {
2786	# set marker and data pointer for current segment
2787	my $marker = $nextMarker;
2788	my $segDataPt = $nextSegDataPt;
2789	my $segPos = $nextSegPos;
2790	undef $nextMarker;
2791	undef $nextSegDataPt;
2792	#
2793	# read ahead to the next segment unless we have reached EOI or SOS
2794	#
2795	unless ($marker and ($marker==0xd9 or ($marker==0xda and not $wantPreview))) {
2796	# read up to next marker (JPEG markers begin with 0xff)
2797	my $buff;
2798	$raf->ReadLine($buff) or last;
2799	# JPEG markers can be padded with unlimited 0xff's
2800	for (;;) {
2801	$raf->Read($ch, 1) or last Marker;
2802	$nextMarker = ord($ch);
2803	last unless $nextMarker == 0xff;
2804	}
2805	# read data for all markers except 0xd9 (EOI) and stand-alone
2806	# markers 0x00, 0x01 and 0xd0-0xd7 (NULL, TEM, RST0-RST7)
2807	if ($nextMarker!=0xd9 and $nextMarker!=0x00 and $nextMarker!=0x01 and
2808	($nextMarker<0xd0 or $nextMarker>0xd7))
2809	{
2810	# read record length word
2811	last unless $raf->Read($s, 2) == 2;
2812	my $len = unpack('n',$s); # get data length
2813	last unless defined($len) and $len >= 2;
2814	$nextSegPos = $raf->Tell();
2815	$len -= 2; # subtract size of length word
2816	last unless $raf->Read($buff, $len) == $len;
2817	$nextSegDataPt = \$buff; # set pointer to our next data
2818	}
2819	# read second segment too if this was the first
2820	next unless defined $marker;
2821	}
2822	# set some useful variables for the current segment
2823	my $hdr = "\xff" . chr($marker); # header for this segment
2824	my $markerName = JpegMarkerName($marker);
2825	#
2826	# parse the current segment
2827	#
2828	# handle SOF markers: SOF0-SOF15, except DHT(0xc4), JPGA(0xc8) and DAC(0xcc)
2829	if (($marker & 0xf0) == 0xc0 and ($marker == 0xc0 or $marker & 0x03)) {
2830	$length = length $$segDataPt;
2831	if ($verbose) {
2832	print $out "JPEG $markerName ($length bytes):\n";
2833	HexDump($segDataPt, undef, %dumpParms, Addr=>$segPos) if $verbose>2;
2834	}
2835	next unless $length >= 6;
2836	# extract some useful information
2837	my ($p, $h, $w, $n) = unpack('Cn2C', $$segDataPt);
2838	my $sof = GetTagTable('Image::ExifTool::JPEG::SOF');
2839	$self->FoundTag($$sof{ImageWidth}, $w);
2840	$self->FoundTag($$sof{ImageHeight}, $h);
2841	$self->FoundTag($$sof{EncodingProcess}, $marker - 0xc0);
2842	$self->FoundTag($$sof{BitsPerSample}, $p);
2843	$self->FoundTag($$sof{ColorComponents}, $n);
2844	next unless $n == 3 and $length >= 15;
2845	my ($i, $hmin, $hmax, $vmin, $vmax);
2846	# loop through all components to determine sampling frequency
2847	for ($i=0; $i<$n; ++$i) {
2848	my $sf = Get8u($segDataPt, 7 + 3 * $i);
2849	# isolate horizontal and vertical components
2850	my ($hf, $vf) = ($sf >> 4, $sf & 0x0f);
2851	unless ($i) {
2852	$hmin = $hmax = $hf;
2853	$vmin = $vmax = $vf;
2854	next;
2855	}
2856	# determine min/max frequencies
2857	$hmin = $hf if $hf < $hmin;
2858	$hmax = $hf if $hf > $hmax;
2859	$vmin = $vf if $vf < $vmin;
2860	$vmax = $vf if $vf > $vmax;
2861	}
2862	if ($hmin and $vmin) {
2863	my ($hs, $vs) = ($hmax / $hmin, $vmax / $vmin);
2864	$self->FoundTag($$sof{YCbCrSubSampling}, "$hs $vs");
2865	}
2866	next;
2867	} elsif ($marker == 0xd9) { # EOI
2868	$verbose and print $out "JPEG EOI\n";
2869	my $pos = $raf->Tell();
2870	if ($htmlDump and $dumpEnd) {
2871	$self->HtmlDump($dumpEnd, $pos-2-$dumpEnd, '[JPEG Image Data]', undef, 0x08);
2872	$self->HtmlDump($pos-2, 2, 'JPEG EOI', undef);
2873	$dumpEnd = 0;
2874	}
2875	$success = 1;
2876	# we are here because we are looking for trailer information
2877	if ($wantPreview and $self->{VALUE}->{PreviewImageStart}) {
2878	my $buff;
2879	# most previews start right after the JPEG EOI, but the Olympus E-20
2880	# preview is 508 bytes into the trailer, and the K-M Maxxum 7D preview
2881	# is 979 bytes in, but Minolta previews can have a random first byte...
2882	if ($raf->Read($buff, 1024) and ($buff =~ /\xff\xd8\xff./g or
2883	($self->{CameraMake} =~ /Minolta/i and $buff =~ /.\xd8\xff\xdb/g)))
2884	{
2885	# adjust PreviewImageStart to this location
2886	my $start = $self->{VALUE}->{PreviewImageStart};
2887	my $actual = $pos + pos($buff) - 4;
2888	if ($start ne $actual and $verbose > 1) {
2889	print $out "(Fixed PreviewImage location: $start -> $actual)\n";
2890	}
2891	$self->{VALUE}->{PreviewImageStart} = $actual;
2892	}
2893	$raf->Seek($pos, 0);
2894	}
2895	# process trailer now or finish processing trailers
2896	# and scan for AFCP if necessary
2897	my $fromEnd = 0;
2898	if ($trailInfo) {
2899	$$trailInfo{ScanForAFCP} = 1; # scan now if necessary
2900	$self->ProcessTrailers($trailInfo);
2901	# save offset from end of file to start of first trailer
2902	$fromEnd = $$trailInfo{Offset};
2903	undef $trailInfo;
2904	}
2905	# finally, dump remaining information in JPEG trailer
2906	if ($verbose or $htmlDump) {
2907	$raf->Seek(0, 2);
2908	my $endPos = $raf->Tell() - $fromEnd;
2909	$self->DumpUnknownTrailer({
2910	RAF => $raf,
2911	DataPos => $pos,
2912	DirLen => $endPos - $pos
2913	}) if $endPos > $pos;
2914	}
2915	last; # all done parsing file
2916	} elsif ($marker == 0xda) { # SOS
2917	# all done with meta information unless we have a trailer
2918	$verbose and print $out "JPEG SOS\n";
2919	unless ($self->Options('FastScan')) {
2920	$trailInfo = IdentifyTrailer($raf);
2921	# process trailer now unless we are doing verbose dump
2922	if ($trailInfo and $verbose < 3 and not $htmlDump) {
2923	# process trailers (keep trailInfo to finish processing later
2924	# only if we can't finish without scanning from end of file)
2925	$self->ProcessTrailers($trailInfo) and undef $trailInfo;
2926	}
2927	if ($wantPreview) {
2928	# seek ahead and validate preview image
2929	my $buff;
2930	my $curPos = $raf->Tell();
2931	if ($raf->Seek($self->GetValue('PreviewImageStart'), 0) and
2932	$raf->Read($buff, 4) == 4 and
2933	$buff =~ /^.\xd8\xff[\xc4\xdb\xe0-\xef]/)
2934	{
2935	undef $wantPreview;
2936	}
2937	$raf->Seek($curPos, 0) or last;
2938	}
2939	next if $trailInfo or $wantPreview or $verbose > 2 or $htmlDump;
2940	}
2941	# nothing interesting to parse after start of scan (SOS)
2942	$success = 1;
2943	last; # all done parsing file
2944	} elsif ($marker==0x00 or $marker==0x01 or ($marker>=0xd0 and $marker<=0xd7)) {
2945	# handle stand-alone markers 0x00, 0x01 and 0xd0-0xd7 (NULL, TEM, RST0-RST7)
2946	$verbose and $marker and print $out "JPEG $markerName:\n";
2947	next;
2948	}
2949	# handle all other markers
2950	my $dumpType = '';
2951	$length = length $$segDataPt;
2952	if ($verbose) {
2953	print $out "JPEG $markerName ($length bytes):\n";
2954	if ($verbose > 2) {
2955	my %extraParms = ( Addr => $segPos );
2956	$extraParms{MaxLen} = 128 if $verbose == 4;
2957	HexDump($segDataPt, undef, %dumpParms, %extraParms);
2958	}
2959	}
2960	if ($marker == 0xe0) { # APP0 (JFIF, CIFF)
2961	if ($$segDataPt =~ /^JFIF\0/) {
2962	$dumpType = 'JFIF';
2963	my %dirInfo = (
2964	DataPt => $segDataPt,
2965	DataPos => $segPos,
2966	DirStart => 5,
2967	DirLen => $length - 5,
2968	);
2969	SetByteOrder('MM');
2970	my $tagTablePtr = GetTagTable('Image::ExifTool::JFIF::Main');
2971	$self->ProcessDirectory(\%dirInfo, $tagTablePtr);
2972	} elsif ($$segDataPt =~ /^JFXX\0\x10/) {
2973	$dumpType = 'JFXX';
2974	my $tagTablePtr = GetTagTable('Image::ExifTool::JFIF::Extension');
2975	my $tagInfo = $self->GetTagInfo($tagTablePtr, 0x10);
2976	$self->FoundTag($tagInfo, substr($$segDataPt, 6));
2977	} elsif ($$segDataPt =~ /^(II\|MM).{4}HEAPJPGM/s) {
2978	$dumpType = 'CIFF';
2979	my %dirInfo = (
2980	RAF => new File::RandomAccess($segDataPt),
2981	);
2982	$self->{SET_GROUP1} = 'CIFF';
2983	require Image::ExifTool::CanonRaw;
2984	Image::ExifTool::CanonRaw::ProcessCRW($self, \%dirInfo);
2985	delete $self->{SET_GROUP1};
2986	}
2987	} elsif ($marker == 0xe1) { # APP1 (EXIF, XMP)
2988	if ($$segDataPt =~ /^Exif\0/) { # (some Kodak cameras don't put a second \0)
2989	undef $dumpType; # (will be dumped here)
2990	# this is EXIF data --
2991	# get the data block (into a common variable)
2992	my $hdrLen = length($exifAPP1hdr);
2993	my %dirInfo = (
2994	Parent => $markerName,
2995	DataPt => $segDataPt,
2996	DataPos => $segPos,
2997	DirStart => $hdrLen,
2998	Base => $segPos + $hdrLen,
2999	);
3000	if ($htmlDump) {
3001	$self->HtmlDump($segPos-4, 4, 'APP1 header',
3002	"Data size: $length bytes");
3003	$self->HtmlDump($segPos, $hdrLen, 'Exif header',
3004	'APP1 data type: Exif');
3005	$dumpEnd = $segPos + $length;
3006	}
3007	# extract the EXIF information (it is in standard TIFF format)
3008	$self->ProcessTIFF(\%dirInfo);
3009	# avoid looking for preview unless necessary because it really slows
3010	# us down -- only look for it if we found pointer, and preview is
3011	# outside EXIF, and PreviewImage is specifically requested
3012	my $start = $self->GetValue('PreviewImageStart');
3013	my $length = $self->GetValue('PreviewImageLength');
3014	if ($start and $length and
3015	$start + $length > $self->{EXIF_POS} + length($self->{EXIF_DATA}) and
3016	$self->{REQ_TAG_LOOKUP}->{previewimage})
3017	{
3018	$wantPreview = 1;
3019	}
3020	} else {
3021	# Hmmm. Could be XMP, let's see
3022	my $processed;
3023	if ($$segDataPt =~ /^http/ or $$segDataPt =~ /<exif:/) {
3024	$dumpType = 'XMP';
3025	my $start = ($$segDataPt =~ /^$xmpAPP1hdr/) ? length($xmpAPP1hdr) : 0;
3026	my $tagTablePtr = GetTagTable('Image::ExifTool::XMP::Main');
3027	my %dirInfo = (
3028	Base => 0,
3029	DataPt => $segDataPt,
3030	DataPos => $segPos,
3031	DataLen => $length,
3032	DirStart => $start,
3033	DirLen => $length - $start,
3034	Parent => $markerName,
3035	);
3036	$processed = $self->ProcessDirectory(\%dirInfo, $tagTablePtr);
3037	}
3038	if ($verbose and not $processed) {
3039	$self->Warn("Ignored EXIF block length $length (bad header)");
3040	}
3041	}
3042	} elsif ($marker == 0xe2) { # APP2 (ICC Profile, FPXR)
3043	if ($$segDataPt =~ /^ICC_PROFILE\0/) {
3044	$dumpType = 'ICC_Profile';
3045	# must concatenate blocks of profile
3046	my $block_num = Get8u($segDataPt, 12);
3047	my $blocks_tot = Get8u($segDataPt, 13);
3048	$icc_profile = '' if $block_num == 1;
3049	if (defined $icc_profile) {
3050	$icc_profile .= substr($$segDataPt, 14);
3051	if ($block_num == $blocks_tot) {
3052	my $tagTablePtr = GetTagTable('Image::ExifTool::ICC_Profile::Main');
3053	my %dirInfo = (
3054	DataPt => \$icc_profile,
3055	DataPos => $segPos + 14,
3056	DataLen => length($icc_profile),
3057	DirStart => 0,
3058	DirLen => length($icc_profile),
3059	Parent => $markerName,
3060	);
3061	$self->ProcessDirectory(\%dirInfo, $tagTablePtr);
3062	undef $icc_profile;
3063	}
3064	}
3065	} elsif ($$segDataPt =~ /^FPXR\0/) {
3066	$dumpType = 'FPXR';
3067	my $tagTablePtr = GetTagTable('Image::ExifTool::FlashPix::Main');
3068	my %dirInfo = (
3069	DataPt => $segDataPt,
3070	DataPos => $segPos,
3071	DataLen => $length,
3072	DirStart => 0,
3073	DirLen => $length,
3074	Parent => $markerName,
3075	# set flag if this is the last FPXR segment
3076	LastFPXR => not ($nextMarker==$marker and $$nextSegDataPt=~/^FPXR\0/),
3077	);
3078	$self->ProcessDirectory(\%dirInfo, $tagTablePtr);
3079	}
3080	} elsif ($marker == 0xe3) { # APP3 (Kodak "Meta")
3081	if ($$segDataPt =~ /^(Meta\|META\|Exif)\0\0/) {
3082	undef $dumpType; # (will be dumped here)
3083	my %dirInfo = (
3084	Parent => $markerName,
3085	DataPt => $segDataPt,
3086	DataPos => $segPos,
3087	DirStart => 6,
3088	Base => $segPos + 6,
3089	);
3090	if ($htmlDump) {
3091	$self->HtmlDump($segPos-4, 10, 'APP3 Meta header');
3092	$dumpEnd = $segPos + $length;
3093	}
3094	my $tagTablePtr = GetTagTable('Image::ExifTool::Kodak::Meta');
3095	$self->ProcessTIFF(\%dirInfo, $tagTablePtr);
3096	}
3097	} elsif ($marker == 0xe5) { # APP5 (Ricoh "RMETA")
3098	if ($$segDataPt =~ /^RMETA\0/) {
3099	$dumpType = 'Ricoh RMETA';
3100	my %dirInfo = (
3101	Parent => $markerName,
3102	DataPt => $segDataPt,
3103	DataPos => $segPos,
3104	DirStart => 6,
3105	Base => $segPos + 6,
3106	);
3107	my $tagTablePtr = GetTagTable('Image::ExifTool::Ricoh::RMETA');
3108	$self->ProcessDirectory(\%dirInfo, $tagTablePtr);
3109	}
3110	} elsif ($marker == 0xe6) { # APP6 (Toshiba EPPIM)
3111	if ($$segDataPt =~ /^EPPIM\0/) {
3112	undef $dumpType; # (will be dumped here)
3113	my %dirInfo = (
3114	Parent => $markerName,
3115	DataPt => $segDataPt,
3116	DataPos => $segPos,
3117	DirStart => 6,
3118	Base => $segPos + 6,
3119	);
3120	if ($htmlDump) {
3121	$self->HtmlDump($segPos-4, 10, 'APP6 EPPIM header');
3122	$dumpEnd = $segPos + $length;
3123	}
3124	my $tagTablePtr = GetTagTable('Image::ExifTool::JPEG::EPPIM');
3125	$self->ProcessTIFF(\%dirInfo, $tagTablePtr);
3126	}
3127	} elsif ($marker == 0xe8) { # APP8 (SPIFF)
3128	# my sample SPIFF has 32 bytes of data, but spec states 30
3129	if ($$segDataPt =~ /^SPIFF\0/ and $length == 32) {
3130	$dumpType = 'SPIFF';
3131	my %dirInfo = (
3132	DataPt => $segDataPt,
3133	DataPos => $segPos,
3134	DirStart => 6,
3135	DirLen => $length - 6,
3136	);
3137	my $tagTablePtr = GetTagTable('Image::ExifTool::JPEG::SPIFF');
3138	$self->ProcessDirectory(\%dirInfo, $tagTablePtr);
3139	}
3140	} elsif ($marker == 0xea) { # APP10 (PhotoStudio Unicode comments)
3141	if ($$segDataPt =~ /^UNICODE\0/) {
3142	$dumpType = 'PhotoStudio';
3143	my $comment = $self->Unicode2Charset(substr($$segDataPt,8), 'MM');
3144	$self->FoundTag('Comment', $comment);
3145	}
3146	} elsif ($marker == 0xec) { # APP12 (Ducky, Picture Info)
3147	if ($$segDataPt =~ /^Ducky/) {
3148	$dumpType = 'Ducky';
3149	my %dirInfo = (
3150	DataPt => $segDataPt,
3151	DataPos => $segPos,
3152	DirStart => 5,
3153	DirLen => $length - 5,
3154	);
3155	my $tagTablePtr = GetTagTable('Image::ExifTool::APP12::Ducky');
3156	$self->ProcessDirectory(\%dirInfo, $tagTablePtr);
3157	} else {
3158	my %dirInfo = ( DataPt => $segDataPt );
3159	my $tagTablePtr = GetTagTable('Image::ExifTool::APP12::PictureInfo');
3160	$self->ProcessDirectory(\%dirInfo, $tagTablePtr) and $dumpType = 'Picture Info';
3161	}
3162	} elsif ($marker == 0xed) { # APP13 (Photoshop, Adobe_CM)
3163	my $isOld;
3164	if ($$segDataPt =~ /^$psAPP13hdr/ or ($$segDataPt =~ /^$psAPP13old/ and $isOld=1)) {
3165	$dumpType = 'Photoshop';
3166	# add this data to the combined data if it exists
3167	if (defined $combinedSegData) {
3168	$combinedSegData .= substr($$segDataPt,length($psAPP13hdr));
3169	$segDataPt = \$combinedSegData;
3170	$length = length $combinedSegData; # update length
3171	}
3172	# peek ahead to see if the next segment is photoshop data too
3173	if ($nextMarker == $marker and $$nextSegDataPt =~ /^$psAPP13hdr/) {
3174	# initialize combined data if necessary
3175	$combinedSegData = $$segDataPt unless defined $combinedSegData;
3176	next; # will handle the combined data the next time around
3177	}
3178	my $hdrlen = $isOld ? 27 : 14;
3179	# process APP13 Photoshop record
3180	my $tagTablePtr = GetTagTable('Image::ExifTool::Photoshop::Main');
3181	my %dirInfo = (
3182	DataPt => $segDataPt,
3183	DataPos => $segPos,
3184	DataLen => $length,
3185	DirStart => $hdrlen, # directory starts after identifier
3186	DirLen => $length - $hdrlen,
3187	Parent => $markerName,
3188	);
3189	$self->ProcessDirectory(\%dirInfo, $tagTablePtr);
3190	undef $combinedSegData;
3191	} elsif ($$segDataPt =~ /^Adobe_CM/) {
3192	$dumpType = 'Adobe_CM';
3193	SetByteOrder('MM');
3194	my $tagTablePtr = GetTagTable('Image::ExifTool::JPEG::AdobeCM');
3195	my %dirInfo = (
3196	DataPt => $segDataPt,
3197	DataPos => $segPos,
3198	DirStart => 8,
3199	DirLen => $length - 8,
3200	);
3201	$self->ProcessDirectory(\%dirInfo, $tagTablePtr);
3202	}
3203	} elsif ($marker == 0xee) { # APP14 (Adobe)
3204	if ($$segDataPt =~ /^Adobe/) {
3205	$dumpType = 'Adobe';
3206	SetByteOrder('MM');
3207	my $tagTablePtr = GetTagTable('Image::ExifTool::JPEG::Adobe');
3208	my %dirInfo = (
3209	DataPt => $segDataPt,
3210	DataPos => $segPos,
3211	DirStart => 5,
3212	DirLen => $length - 5,
3213	);
3214	$self->ProcessDirectory(\%dirInfo, $tagTablePtr);
3215	}
3216	} elsif ($marker == 0xef) { # APP15 (GraphicConverter)
3217	if ($$segDataPt =~ /^Q\s*(\d+)/ and $length == 4) {
3218	$dumpType = 'GraphicConverter';
3219	my $tagTablePtr = GetTagTable('Image::ExifTool::JPEG::GraphConv');
3220	$self->HandleTag($tagTablePtr, 'Q', $1);
3221	}
3222	} elsif ($marker == 0xfe) { # COM (JPEG comment)
3223	$dumpType = 'Comment';
3224	$self->FoundTag('Comment', $$segDataPt);
3225	} elsif (($marker & 0xf0) != 0xe0) {
3226	undef $dumpType; # only dump unknown APP segments
3227	}
3228	if (defined $dumpType) {
3229	if (not $dumpType and $self->{OPTIONS}->{Unknown}) {
3230	$self->Warn("Unknown $markerName segment", 1);
3231	}
3232	if ($htmlDump) {
3233	my $desc = $markerName . ($dumpType ? " $dumpType" : '') . ' segment';
3234	$self->HtmlDump($segPos-4, $length+4, $desc, undef, 0x08);
3235	$dumpEnd = $segPos + $length;
3236	}
3237	}
3238	undef $$segDataPt;
3239	}
3240	$/ = $oldsep; # restore separator to original value
3241	$success or $self->Warn('JPEG format error');
3242	return 1;
3243	}
3244
3245	#------------------------------------------------------------------------------
3246	# Process TIFF data
3247	# Inputs: 0) ExifTool object reference, 1) directory information reference
3248	# 2) optional tag table reference
3249	# Returns: 1 if this looked like a valid EXIF block, 0 otherwise, or -1 on write error
3250	sub ProcessTIFF($$;$)
3251	{
3252	my ($self, $dirInfo, $tagTablePtr) = @_;
3253	my $dataPt = $$dirInfo{DataPt};
3254	my $fileType = $$dirInfo{Parent} \|\| '';
3255	my $raf = $$dirInfo{RAF};
3256	my $base = $$dirInfo{Base} \|\| 0;
3257	my $outfile = $$dirInfo{OutFile};
3258	my ($length, $err, $canonSig);
3259
3260	# read the image file header and offset to 0th IFD if necessary
3261	if ($raf) {
3262	if ($outfile) {
3263	$raf->Seek(0, 0) or return 0;
3264	if ($base) {
3265	$raf->Read($$dataPt, $base) == $base or return 0;
3266	Write($outfile, $$dataPt) or $err = 1;
3267	}
3268	} else {
3269	$raf->Seek($base, 0) or return 0;
3270	}
3271	$raf->Read($self->{EXIF_DATA}, 8) == 8 or return 0;
3272	} elsif ($dataPt) {
3273	# save a copy of the EXIF data
3274	my $dirStart = $$dirInfo{DirStart} \|\| 0;
3275	$self->{EXIF_DATA} = substr(${$$dirInfo{DataPt}}, $dirStart);
3276	} elsif ($outfile) {
3277	# create TIFF information from scratch
3278	$self->{EXIF_DATA} = "MM\0\x2a\0\0\0\x08";
3279	} else {
3280	$self->{EXIF_DATA} = '';
3281	}
3282	$$self{FIRST_EXIF_POS} = $base + $$self{BASE} unless defined $$self{FIRST_EXIF_POS};
3283	$$self{EXIF_POS} = $base;
3284	$dataPt = \$self->{EXIF_DATA};
3285
3286	# set byte ordering
3287	SetByteOrder(substr($$dataPt,0,2)) or return 0;
3288	# save EXIF byte ordering
3289	$self->{EXIF_BYTE_ORDER} = GetByteOrder();
3290
3291	# verify the byte ordering
3292	my $identifier = Get16u($dataPt, 2);
3293	# identifier is 0x2a for TIFF (but 0x4f52, 0x5352 or ?? for ORF)
3294	# no longer do this because ORF files use different values
3295	# return 0 unless $identifier == 0x2a;
3296
3297	# get offset to IFD0
3298	my $offset = Get32u($dataPt, 4);
3299	$offset >= 8 or return 0;
3300
3301	if ($raf) {
3302	# Canon CR2 images usually have an offset of 16, but it may be
3303	# greater if edited by PhotoMechanic, so check the 4-byte signature
3304	if ($identifier == 0x2a and $offset >= 16) {
3305	$raf->Read($canonSig, 8) == 8 or return 0;
3306	$$dataPt .= $canonSig;
3307	if ($canonSig =~ /^CR\x02\0/) {
3308	$fileType = 'CR2';
3309	$self->HtmlDump($base+8, 8, '[CR2 header]') if $self->{HTML_DUMP};
3310	} else {
3311	undef $canonSig;
3312	}
3313	} elsif ($identifier == 0x55 and $fileType =~ /^(RAW\|TIFF)$/) {
3314	$fileType = 'RAW'; # Panasonic RAW file
3315	$tagTablePtr = GetTagTable('Image::ExifTool::Panasonic::Raw');
3316	} elsif ($identifier == 0x2b and $fileType eq 'TIFF') {
3317	# this looks like a BigTIFF image
3318	$raf->Seek(0);
3319	require Image::ExifTool::BigTIFF;
3320	return 1 if Image::ExifTool::BigTIFF::ProcessBTF($self, $dirInfo);
3321	} elsif (Get8u($dataPt, 2) == 0xbc and $fileType eq 'TIFF') {
3322	$fileType = 'WDP'; # Windows Media Photo file
3323	}
3324	# we have a valid TIFF (or whatever) file
3325	if ($fileType and not $self->{VALUE}->{FileType}) {
3326	$self->SetFileType($fileType);
3327	}
3328	}
3329	$self->FoundTag('ExifByteOrder', GetByteOrder());
3330	if ($self->{HTML_DUMP}) {
3331	my $o = (GetByteOrder() eq 'II') ? 'Little' : 'Big';
3332	$self->HtmlDump($base, 4, "TIFF header", "Byte order: $o endian", 0);
3333	$self->HtmlDump($base+4, 4, "IFD0 pointer", sprintf("Offset: 0x%.4x",$offset), 0);
3334	}
3335	# remember where we found the TIFF data (APP1, APP3, TIFF, NEF, etc...)
3336	$self->{TIFF_TYPE} = $fileType;
3337
3338	# get reference to the main EXIF table
3339	$tagTablePtr or $tagTablePtr = GetTagTable('Image::ExifTool::Exif::Main');
3340
3341	# build directory information hash
3342	my %dirInfo = (
3343	Base => $base,
3344	DataPt => $dataPt,
3345	DataLen => length $$dataPt,
3346	DataPos => 0,
3347	DirStart => $offset,
3348	DirLen => length $$dataPt,
3349	RAF => $raf,
3350	DirName => 'IFD0',
3351	Parent => $fileType,
3352	ImageData=> 1, # set flag to get information to copy image data later
3353	);
3354
3355	# extract information from the image
3356	unless ($outfile) {
3357	# process the directory
3358	$self->ProcessDirectory(\%dirInfo, $tagTablePtr);
3359	# process GeoTiff information if available
3360	if ($self->{VALUE}->{GeoTiffDirectory}) {
3361	require Image::ExifTool::GeoTiff;
3362	Image::ExifTool::GeoTiff::ProcessGeoTiff($self);
3363	}
3364	# process information in recognized trailers
3365	if ($raf) {
3366	my $trailInfo = IdentifyTrailer($raf);
3367	if ($trailInfo) {
3368	$$trailInfo{ScanForAFCP} = 1; # scan to find AFCP if necessary
3369	$self->ProcessTrailers($trailInfo);
3370	}
3371	}
3372	return 1;
3373	}
3374	#
3375	# rewrite the image
3376	#
3377	if ($$dirInfo{NoTiffEnd}) {
3378	delete $self->{TIFF_END};
3379	} else {
3380	# initialize TIFF_END so it will be updated by WriteExif()
3381	$self->{TIFF_END} = 0;
3382	}
3383	if ($canonSig) {
3384	# write Canon CR2 specially because it has a header we want to preserve,
3385	# and possibly trailers added by the Canon utilities and/or PhotoMechanic
3386	$dirInfo{OutFile} = $outfile;
3387	require Image::ExifTool::CanonRaw;
3388	Image::ExifTool::CanonRaw::WriteCR2($self, \%dirInfo, $tagTablePtr) or $err = 1;
3389	} else {
3390	# write TIFF header (8 bytes to be immediately followed by IFD)
3391	$dirInfo{NewDataPos} = 8;
3392	# preserve padding between image data blocks in ORF images
3393	# (otherwise dcraw has problems because it assumes fixed block spacing)
3394	$dirInfo{PreserveImagePadding} = 1 if $fileType eq 'ORF' or $identifier != 0x2a;
3395	my $newData = $self->WriteDirectory(\%dirInfo, $tagTablePtr);
3396	if (not defined $newData) {
3397	$err = 1;
3398	} elsif (length($newData)) {
3399	my $offset = 8;
3400	my $header = substr($$dataPt, 0, 4) . Set32u($offset);
3401	Write($outfile, $header, $newData) or $err = 1;
3402	undef $newData; # free memory
3403	}
3404	# copy over image data now if necessary
3405	if (ref $dirInfo{ImageData} and not $err) {
3406	$self->CopyImageData($dirInfo{ImageData}, $outfile) or $err = 1;
3407	delete $dirInfo{ImageData};
3408	}
3409	}
3410	# rewrite trailers if they exist
3411	if ($raf and $self->{TIFF_END} and not $err) {
3412	my ($buf, $trailInfo);
3413	$raf->Seek(0, 2) or $err = 1;
3414	my $extra = $raf->Tell() - $self->{TIFF_END};
3415	# check for trailer and process if possible
3416	for (;;) {
3417	last unless $extra > 12;
3418	$raf->Seek($self->{TIFF_END}); # seek back to end of image
3419	$trailInfo = IdentifyTrailer($raf);
3420	last unless $trailInfo;
3421	my $tbuf = '';
3422	$$trailInfo{OutFile} = \$tbuf; # rewrite trailer(s)
3423	$$trailInfo{ScanForAFCP} = 1; # scan for AFCP if necessary
3424	# rewrite all trailers to buffer
3425	unless ($self->ProcessTrailers($trailInfo)) {
3426	undef $trailInfo;
3427	$err = 1;
3428	last;
3429	}
3430	# calculate unused bytes before trailer
3431	$extra = $$trailInfo{DataPos} - $self->{TIFF_END};
3432	last; # yes, the 'for' loop was just a cheap 'goto'
3433	}
3434	# ignore a single zero byte if used for padding
3435	# (note that Photoshop CS adds a trailer with 2 zero bytes
3436	# for some reason, and these will be preserved)
3437	if ($extra > 0 and $self->{TIFF_END} & 0x01) {
3438	$raf->Seek($self->{TIFF_END}, 0) or $err = 1;
3439	$raf->Read($buf, 1) or $err = 1;
3440	$buf eq "\0" and --$extra, ++$self->{TIFF_END};
3441	}
3442	if ($extra > 0) {
3443	if ($self->{DEL_GROUP}->{Trailer}) {
3444	$self->VPrint(0, " Deleting unknown trailer ($extra bytes)\n");
3445	++$self->{CHANGED};
3446	} else {
3447	$self->VPrint(0, " Preserving unknown trailer ($extra bytes)\n");
3448	$raf->Seek($self->{TIFF_END}, 0) or $err = 1;
3449	while ($extra) {
3450	my $n = $extra < 65536 ? $extra : 65536;
3451	$raf->Read($buf, $n) == $n or $err = 1, last;
3452	Write($outfile, $buf) or $err = 1, last;
3453	$extra -= $n;
3454	}
3455	}
3456	}
3457	# write trailer buffer if necessary
3458	$self->WriteTrailerBuffer($trailInfo, $outfile) or $err = 1 if $trailInfo;
3459	# add any new trailers we are creating
3460	my $trailPt = $self->AddNewTrailers();
3461	Write($outfile, $$trailPt) or $err = 1 if $trailPt;
3462	}
3463	delete $self->{TIFF_END};
3464	return $err ? -1 : 1;
3465	}
3466
3467	#------------------------------------------------------------------------------
3468	# Return list of tag table keys (ignoring special keys)
3469	# Inputs: 0) reference to tag table
3470	# Returns: List of table keys (unsorted)
3471	sub TagTableKeys($)
3472	{
3473	local $_;
3474	my $tagTablePtr = shift;
3475	my @keyList;
3476	foreach (keys %$tagTablePtr) {
3477	push(@keyList, $_) unless $specialTags{$_};
3478	}
3479	return @keyList;
3480	}
3481
3482	#------------------------------------------------------------------------------
3483	# GetTagTable
3484	# Inputs: 0) table name
3485	# Returns: tag table reference, or undefined if not found
3486	# Notes: Always use this function instead of requiring module and using table
3487	# directly since this function also does the following the first time the table
3488	# is loaded:
3489	# - requires new module if necessary
3490	# - generates default GROUPS hash and Group 0 name from module name
3491	# - registers Composite tags if Composite table found
3492	# - saves descriptions for tags in specified table
3493	# - generates default TAG_PREFIX to be used for unknown tags
3494	sub GetTagTable($)
3495	{
3496	my $tableName = shift or return undef;
3497
3498	my $table = $allTables{$tableName};
3499
3500	unless ($table) {
3501	no strict 'refs';
3502	unless (defined %$tableName) {
3503	# try to load module for this table
3504	if ($tableName =~ /(.*)::/) {
3505	my $module = $1;
3506	unless (eval "require $module") {
3507	$@ and warn $@;
3508	}
3509	}
3510	unless (defined %$tableName) {
3511	warn "Can't find table $tableName\n";
3512	return undef;
3513	}
3514	}
3515	no strict 'refs';
3516	$table = \%$tableName;
3517	use strict 'refs';
3518	# set default group 0 and 1 from module name unless already specified
3519	my $defaultGroups = $$table{GROUPS};
3520	$defaultGroups or $defaultGroups = $$table{GROUPS} = { };
3521	unless ($$defaultGroups{0} and $$defaultGroups{1}) {
3522	if ($tableName =~ /Image::.?::([^:])/) {
3523	$$defaultGroups{0} = $1 unless $$defaultGroups{0};
3524	$$defaultGroups{1} = $1 unless $$defaultGroups{1};
3525	} else {
3526	$$defaultGroups{0} = $tableName unless $$defaultGroups{0};
3527	$$defaultGroups{1} = $tableName unless $$defaultGroups{1};
3528	}
3529	}
3530	$$defaultGroups{2} = 'Other' unless $$defaultGroups{2};
3531	# generate a tag prefix for unknown tags if necessary
3532	unless ($$table{TAG_PREFIX}) {
3533	my $tagPrefix;
3534	if ($tableName =~ /Image::.?::(.)::Main/ \|\| $tableName =~ /Image::.?::(.)/) {
3535	($tagPrefix = $1) =~ s/::/_/g;
3536	} else {
3537	$tagPrefix = $tableName;
3538	}
3539	$$table{TAG_PREFIX} = $tagPrefix;
3540	}
3541	# set up the new table
3542	SetupTagTable($table);
3543	# add any user-defined tags
3544	if (defined %UserDefined and $UserDefined{$tableName}) {
3545	my $tagID;
3546	foreach $tagID (TagTableKeys($UserDefined{$tableName})) {
3547	my $tagInfo = $UserDefined{$tableName}->{$tagID};
3548	if (ref $tagInfo eq 'HASH') {
3549	$$tagInfo{Name} or $$tagInfo{Name} = ucfirst($tagID);
3550	} else {
3551	$tagInfo = { Name => $tagInfo };
3552	}
3553	if ($$table{WRITABLE} and not defined $$tagInfo{Writable} and
3554	not $$tagInfo{SubDirectory})
3555	{
3556	$$tagInfo{Writable} = $$table{WRITABLE};
3557	}
3558	delete $$table{$tagID}; # replace any existing entry
3559	AddTagToTable($table, $tagID, $tagInfo);
3560	}
3561	}
3562	# generate tag ID's if necessary
3563	GenerateTagIDs($table) if $didTagID;
3564	# remember order we loaded the tables in
3565	push @tableOrder, $tableName;
3566	# insert newly loaded table into list
3567	$allTables{$tableName} = $table;
3568	}
3569	return $table;
3570	}
3571
3572	#------------------------------------------------------------------------------
3573	# Process an image directory
3574	# Inputs: 0) ExifTool object reference, 1) directory information reference
3575	# 2) tag table reference, 3) optional reference to processing procedure
3576	# Returns: Result from processing (1=success)
3577	sub ProcessDirectory($$$;$)
3578	{
3579	my ($self, $dirInfo, $tagTablePtr, $processProc) = @_;
3580
3581	return 0 unless $tagTablePtr and $dirInfo;
3582	# use default proc from tag table if no proc specified
3583	$processProc or $processProc = $$tagTablePtr{PROCESS_PROC};
3584	# set directory name from default group0 name if not done already
3585	$$dirInfo{DirName} or $$dirInfo{DirName} = $tagTablePtr->{GROUPS}->{0};
3586	# guard against cyclical recursion into the same directory
3587	if (defined $$dirInfo{DirStart} and defined $$dirInfo{DataPos}) {
3588	my $addr = $$dirInfo{DirStart} + $$dirInfo{DataPos} + ($$dirInfo{Base}\|\|0);
3589	if ($self->{PROCESSED}->{$addr}) {
3590	$self->Warn("$$dirInfo{DirName} pointer references previous $self->{PROCESSED}->{$addr} directory");
3591	return 0;
3592	}
3593	$self->{PROCESSED}->{$addr} = $$dirInfo{DirName};
3594	}
3595	# otherwise process as an EXIF directory
3596	$processProc or $processProc = \&Image::ExifTool::Exif::ProcessExif;
3597	my $oldOrder = GetByteOrder();
3598	my $oldIndent = $self->{INDENT};
3599	my $oldDir = $self->{DIR_NAME};
3600	$self->{INDENT} .= '\| ';
3601	$self->{DIR_NAME} = $$dirInfo{DirName};
3602	my $rtnVal = &$processProc($self, $dirInfo, $tagTablePtr);
3603	$self->{INDENT} = $oldIndent;
3604	$self->{DIR_NAME} = $oldDir;
3605	SetByteOrder($oldOrder);
3606	return $rtnVal;
3607	}
3608
3609	#------------------------------------------------------------------------------
3610	# Get standardized file extension
3611	# Inputs: 0) file name
3612	# Returns: standardized extension (all uppercase)
3613	sub GetFileExtension($)
3614	{
3615	my $filename = shift;
3616	my $fileExt;
3617	if ($filename and $filename =~ /.*\.(.+)$/) {
3618	$fileExt = uc($1); # change extension to upper case
3619	# convert TIF extension to TIFF because we use the
3620	# extension for the file type tag of TIFF images
3621	$fileExt eq 'TIF' and $fileExt = 'TIFF';
3622	}
3623	return $fileExt;
3624	}
3625
3626	#------------------------------------------------------------------------------
3627	# Get list of tag information hashes for given tag ID
3628	# Inputs: 0) Tag table reference, 1) tag ID
3629	# Returns: Array of tag information references
3630	# Notes: Generates tagInfo hash if necessary
3631	sub GetTagInfoList($$)
3632	{
3633	my ($tagTablePtr, $tagID) = @_;
3634	my $tagInfo = $$tagTablePtr{$tagID};
3635
3636	if (ref $tagInfo eq 'HASH') {
3637	return ($tagInfo);
3638	} elsif (ref $tagInfo eq 'ARRAY') {
3639	return @$tagInfo;
3640	} elsif ($tagInfo) {
3641	# create hash with name
3642	$tagInfo = $$tagTablePtr{$tagID} = { Name => $tagInfo };
3643	return ($tagInfo);
3644	}
3645	return ();
3646	}
3647
3648	#------------------------------------------------------------------------------
3649	# Find tag information, processing conditional tags
3650	# Inputs: 0) ExifTool object reference, 1) tagTable pointer, 2) tag ID
3651	# 3) optional value reference, 4) optional format type, 5) optional value count
3652	# Returns: pointer to tagInfo hash, undefined if none found, or '' if $valPt needed
3653	# Notes: You should always call this routine to find a tag in a table because
3654	# this routine will evaluate conditional tags.
3655	# Arguments 3-5 are only required if the information type allows $valPt, $format and/or
3656	# $count in a Condition, and if not given when needed this routine returns ''.
3657	sub GetTagInfo($$$;$$$)
3658	{
3659	my ($self, $tagTablePtr, $tagID) = @_;
3660	my ($valPt, $format, $count);
3661
3662	my @infoArray = GetTagInfoList($tagTablePtr, $tagID);
3663	# evaluate condition
3664	my $tagInfo;
3665	foreach $tagInfo (@infoArray) {
3666	my $condition = $$tagInfo{Condition};
3667	if ($condition) {
3668	($valPt, $format, $count) = splice(@_, 3) if @_ > 3;
3669	return '' if $condition =~ /\$(valPt\|format\|count)\b/ and not defined $valPt;
3670	# set old value for use in condition if needed
3671	my $oldVal = $self->{VALUE}->{$$tagInfo{Name}};
3672	#### eval Condition ($self, $oldVal, [$valPt, $format, $count])
3673	unless (eval $condition) {
3674	$@ and warn "Condition $$tagInfo{Name}: $@";
3675	next;
3676	}
3677	}
3678	if ($$tagInfo{Unknown} and not $self->{OPTIONS}->{Unknown}) {
3679	# don't return Unknown tags unless that option is set
3680	return undef;
3681	}
3682	# return the tag information we found
3683	return $tagInfo;
3684	}
3685	# generate information for unknown tags (numerical only) if required
3686	if (not $tagInfo and $self->{OPTIONS}->{Unknown} and $tagID =~ /^\d+$/ and
3687	not $$self{NO_UNKNOWN})
3688	{
3689	my $printConv;
3690	if (defined $$tagTablePtr{PRINT_CONV}) {
3691	$printConv = $$tagTablePtr{PRINT_CONV};
3692	} else {
3693	# limit length of printout (can be very long)
3694	$printConv = 'length($val) > 60 ? substr($val,0,55) . "[...]" : $val';
3695	}
3696	my $hex = sprintf("0x%.4x", $tagID);
3697	my $prefix = $$tagTablePtr{TAG_PREFIX};
3698	$tagInfo = {
3699	Name => "${prefix}_$hex",
3700	Description => MakeDescription($prefix, $hex),
3701	Unknown => 1,
3702	Writable => 0, # can't write unknown tags
3703	PrintConv => $printConv,
3704	};
3705	# add tag information to table
3706	AddTagToTable($tagTablePtr, $tagID, $tagInfo);
3707	} else {
3708	undef $tagInfo;
3709	}
3710	return $tagInfo;
3711	}
3712
3713	#------------------------------------------------------------------------------
3714	# Add new tag to table (must use this routine to add new tags to a table)
3715	# Inputs: 0) reference to tag table, 1) tag ID
3716	# 2) reference to tag information hash
3717	# Notes: - will not overwrite existing entry in table
3718	# - info need contain no entries when this routine is called
3719	sub AddTagToTable($$$)
3720	{
3721	my ($tagTablePtr, $tagID, $tagInfo) = @_;
3722
3723	# define necessary entries in information hash
3724	if ($$tagInfo{Groups}) {
3725	# fill in default groups from table GROUPS
3726	foreach (keys %{$$tagTablePtr{GROUPS}}) {
3727	next if $tagInfo->{Groups}->{$_};
3728	$tagInfo->{Groups}->{$_} = $tagTablePtr->{GROUPS}->{$_};
3729	}
3730	} else {
3731	$$tagInfo{Groups} = $$tagTablePtr{GROUPS};
3732	}
3733	$$tagInfo{Flags} and ExpandFlags($tagInfo);
3734	$$tagInfo{GotGroups} = 1,
3735	$$tagInfo{Table} = $tagTablePtr;
3736	$$tagInfo{TagID} = $tagID;
3737
3738	unless ($$tagInfo{Name}) {
3739	my $prefix = $$tagTablePtr{TAG_PREFIX};
3740	$$tagInfo{Name} = "${prefix}_$tagID";
3741	# make description to prevent tagID from getting mangled by MakeDescription()
3742	$$tagInfo{Description} = MakeDescription($prefix, $tagID);
3743	}
3744	# add tag to table, but never overwrite existing entries (could potentially happen
3745	# if someone thinks there isn't any tagInfo because a condition wasn't satisfied)
3746	$$tagTablePtr{$tagID} = $tagInfo unless defined $$tagTablePtr{$tagID};
3747	}
3748
3749	#------------------------------------------------------------------------------
3750	# Handle simple extraction of new tag information
3751	# Inputs: 0) ExifTool object ref, 1) tag table reference, 2) tagID, 3) value,
3752	# 4-N) parameters hash: Index, DataPt, DataPos, Start, Size, Parent,
3753	# TagInfo, ProcessProc
3754	# Returns: tag key or undef if tag not found
3755	sub HandleTag($$$$;%)
3756	{
3757	my ($self, $tagTablePtr, $tag, $val, %parms) = @_;
3758	my $verbose = $self->{OPTIONS}->{Verbose};
3759	my $tagInfo = $parms{TagInfo} \|\| $self->GetTagInfo($tagTablePtr, $tag);
3760	my $dataPt = $parms{DataPt};
3761	my $subdir;
3762
3763	if ($tagInfo) {
3764	$subdir = $$tagInfo{SubDirectory}
3765	} else {
3766	return undef unless $verbose;
3767	}
3768	# read value if not done already (not necessary for subdir)
3769	unless (defined $val or $subdir) {
3770	my $start = $parms{Start} \|\| 0;
3771	my $size = $parms{Size} \|\| 0;
3772	# read from data in memory if possible
3773	if ($dataPt and $start >= 0 and $start + $size <= length($$dataPt)) {
3774	$val = substr($$dataPt, $start, $size);
3775	} else {
3776	my $name = $tagInfo ? $$tagInfo{Name} : "tag $tag";
3777	$self->Warn("Error extracting value for $name");
3778	return undef;
3779	}
3780	}
3781	# do verbose print if necessary
3782	if ($verbose) {
3783	$parms{Value} = $val;
3784	$parms{Table} = $tagTablePtr;
3785	$self->VerboseInfo($tag, $tagInfo, %parms);
3786	}
3787	if ($tagInfo) {
3788	if ($subdir) {
3789	$dataPt or $dataPt = \$val;
3790	# process subdirectory information
3791	my %dirInfo = (
3792	DirName => $$tagInfo{Name},
3793	DataPt => $dataPt,
3794	DataLen => length $$dataPt,
3795	DataPos => $parms{DataPos},
3796	DirStart => $parms{Start},
3797	DirLen => $parms{Size},
3798	Parent => $parms{Parent},
3799	);
3800	my $subTablePtr = GetTagTable($$subdir{TagTable}) \|\| $tagTablePtr;
3801	$self->ProcessDirectory(\%dirInfo, $subTablePtr, $$subdir{ProcessProc});
3802	} else {
3803	return $self->FoundTag($tagInfo, $val);
3804	}
3805	}
3806	return undef;
3807	}
3808
3809	#------------------------------------------------------------------------------
3810	# Add tag to hash of extracted information
3811	# Inputs: 0) reference to ExifTool object
3812	# 1) reference to tagInfo hash or tag name
3813	# 2) data value (or reference to require hash if composite)
3814	# Returns: tag key or undef if no value
3815	sub FoundTag($$$)
3816	{
3817	local $_;
3818	my ($self, $tagInfo, $value) = @_;
3819	my $tag;
3820
3821	if (ref $tagInfo eq 'HASH') {
3822	$tag = $$tagInfo{Name} or warn("No tag name\n"), return undef;
3823	} else {
3824	$tag = $tagInfo;
3825	# look for tag in Extra
3826	$tagInfo = $self->GetTagInfo(GetTagTable('Image::ExifTool::Extra'), $tag);
3827	# make temporary hash if tag doesn't exist in Extra
3828	# (not advised to do this since the tag won't show in list)
3829	$tagInfo or $tagInfo = { Name => $tag, Groups => \%allGroupsExifTool };
3830	$self->{OPTIONS}->{Verbose} and $self->VerboseInfo(undef, $tagInfo, Value => $value);
3831	}
3832	my $rawValueHash = $self->{VALUE};
3833	if ($$tagInfo{RawConv}) {
3834	my $conv = $$tagInfo{RawConv};
3835	my $val = $value; # must do this in case eval references $val
3836	# initialize @val for use in Composite RawConv expressions
3837	my @val;
3838	if (ref $val eq 'HASH') {
3839	foreach (keys %$val) { $val[$_] = $$rawValueHash{$$val{$_}}; }
3840	}
3841	if (ref $conv eq 'CODE') {
3842	$value = &$conv($val, $self);
3843	} else {
3844	#### eval RawConv ($self, $val)
3845	$value = eval $conv;
3846	$@ and warn "RawConv: $@\n";
3847	}
3848	return undef unless defined $value;
3849	}
3850	# get tag priority
3851	my $priority = $$tagInfo{Priority};
3852	defined $priority or $priority = $tagInfo->{Table}->{PRIORITY};
3853	# handle duplicate tag names
3854	if (defined $rawValueHash->{$tag}) {
3855	if ($$tagInfo{List} and $tagInfo eq $self->{TAG_INFO}->{$tag} and
3856	not $self->{NO_LIST})
3857	{
3858	# use a list reference for multiple values
3859	if (ref $rawValueHash->{$tag} ne 'ARRAY') {
3860	$rawValueHash->{$tag} = [ $rawValueHash->{$tag} ];
3861	}
3862	push @{$rawValueHash->{$tag}}, $value;
3863	return $tag; # return without creating a new entry
3864	}
3865	# get next available tag key
3866	my $nextTag = NextTagKey($rawValueHash, $tag);
3867	#
3868	# take tag with highest priority
3869	#
3870	# promote existing 0-priority tag so it takes precedence over a new 0-tag
3871	my $oldPriority = $self->{PRIORITY}->{$tag} \|\| 1;
3872	# set priority for this tag (default is 1)
3873	$priority = 1 if not defined $priority or
3874	# increase 0-priority tags if this is the priority directory
3875	($priority == 0 and $self->{DIR_NAME} and $self->{PRIORITY_DIR} and
3876	$self->{DIR_NAME} eq $self->{PRIORITY_DIR});
3877	if ($priority >= $oldPriority) {
3878	$self->{MOVED_KEY} = $nextTag; # used in BuildCompositeTags()
3879	$self->{PRIORITY}->{$nextTag} = $self->{PRIORITY}->{$tag};
3880	$rawValueHash->{$nextTag} = $rawValueHash->{$tag};
3881	$self->{FILE_ORDER}->{$nextTag} = $self->{FILE_ORDER}->{$tag};
3882	$self->{TAG_INFO}->{$nextTag} = $self->{TAG_INFO}->{$tag};
3883	if ($self->{GROUP1}->{$tag}) {
3884	$self->{GROUP1}->{$nextTag} = $self->{GROUP1}->{$tag};
3885	delete $self->{GROUP1}->{$tag};
3886	}
3887	} else {
3888	$tag = $nextTag; # don't override the existing tag
3889	}
3890	$self->{PRIORITY}->{$tag} = $priority;
3891	} elsif ($priority) {
3892	# set tag priority (only if exists and non-zero)
3893	$self->{PRIORITY}->{$tag} = $priority;
3894	}
3895
3896	# save the raw value, file order, tagInfo ref and group1 name if necessary
3897	$rawValueHash->{$tag} = $value;
3898	$self->{FILE_ORDER}->{$tag} = ++$self->{NUM_FOUND};
3899	$self->{TAG_INFO}->{$tag} = $tagInfo;
3900	$self->{GROUP1}->{$tag} = $self->{SET_GROUP1} if $self->{SET_GROUP1};
3901
3902	return $tag;
3903	}
3904
3905	#------------------------------------------------------------------------------
3906	# Get next available tag key
3907	# Inputs: 0) hash reference (keys are tag keys), 1) tag name
3908	# Returns: next available tag key
3909	sub NextTagKey($$)
3910	{
3911	my ($info, $tag) = @_;
3912	if (exists $$info{$tag}) {
3913	my $name = $tag;
3914	my $i;
3915	for ($i=1; ; ++$i) {
3916	$tag = "$name ($i)";
3917	last unless exists $$info{$tag};
3918	}
3919	}
3920	return $tag;
3921	}
3922
3923	#------------------------------------------------------------------------------
3924	# Make current directory the priority directory if not set already
3925	# Inputs: 0) reference to ExifTool object
3926	sub SetPriorityDir($)
3927	{
3928	my $self = shift;
3929	$self->{PRIORITY_DIR} = $self->{DIR_NAME} unless $self->{PRIORITY_DIR};
3930	}
3931
3932	#------------------------------------------------------------------------------
3933	# Set family 1 group name specific to this tag instance
3934	# Inputs: 0) reference to ExifTool object, 1) tag key, 2) group name
3935	sub SetGroup1($$$)
3936	{
3937	my ($self, $tagKey, $extra) = @_;
3938	$self->{GROUP1}->{$tagKey} = $extra;
3939	}
3940
3941	#------------------------------------------------------------------------------
3942	# Set ID's for all tags in specified table
3943	# Inputs: 0) tag table reference
3944	sub GenerateTagIDs($)
3945	{
3946	my $table = shift;
3947
3948	unless ($$table{DID_TAG_ID}) {
3949	$$table{DID_TAG_ID} = 1; # set flag so we won't do this table again
3950	my ($tagID, $tagInfo);
3951	foreach $tagID (keys %$table) {
3952	next if $specialTags{$tagID};
3953	# define tag ID in each element of conditional array
3954	my @infoArray = GetTagInfoList($table,$tagID);
3955	foreach $tagInfo (@infoArray) {
3956	# define tag ID's in info hash
3957	$$tagInfo{TagID} = $tagID;
3958	}
3959	}
3960	}
3961	}
3962
3963	#------------------------------------------------------------------------------
3964	# Generate TagID's for all loaded tables
3965	# Inputs: None
3966	# Notes: Causes subsequently loaded tables to automatically generate TagID's too
3967	sub GenerateAllTagIDs()
3968	{
3969	unless ($didTagID) {
3970	my $tableName;
3971	foreach $tableName (keys %allTables) {
3972	# generate tag ID's for all tags in this table
3973	GenerateTagIDs($allTables{$tableName});
3974	}
3975	$didTagID = 1;
3976	}
3977	}
3978
3979	#------------------------------------------------------------------------------
3980	# Delete specified tag
3981	# Inputs: 0) reference to ExifTool object
3982	# 1) tag key
3983	sub DeleteTag($$)
3984	{
3985	my ($self, $tag) = @_;
3986	delete $self->{VALUE}->{$tag};
3987	delete $self->{FILE_ORDER}->{$tag};
3988	delete $self->{TAG_INFO}->{$tag};
3989	delete $self->{GROUP1}->{$tag};
3990	}
3991
3992	#------------------------------------------------------------------------------
3993	# Set the FileType and MIMEType tags
3994	# Inputs: 0) ExifTool object reference
3995	# 1) Optional file type (uses FILE_TYPE if not specified)
3996	sub SetFileType($;$)
3997	{
3998	my $self = shift;
3999	my $baseType = $self->{FILE_TYPE};
4000	my $fileType = shift \|\| $baseType;
4001	my $mimeType = $mimeType{$fileType};
4002	# use base file type if necessary (except if 'TIFF', which is a special case)
4003	$mimeType = $mimeType{$baseType} unless $mimeType or $baseType eq 'TIFF';
4004	$self->FoundTag('FileType', $fileType);
4005	$self->FoundTag('MIMEType', $mimeType \|\| 'application/unknown');
4006	}
4007
4008	#------------------------------------------------------------------------------
4009	# Modify the value of the MIMEType tag
4010	# Inputs: 0) ExifTool object reference, 1) file or MIME type
4011	# Notes: combines existing type with new type: ie) a/b + c/d => c/b-d
4012	sub ModifyMimeType($;$)
4013	{
4014	my ($self, $mime) = @_;
4015	$mime =~ m{/} or $mime = $mimeType{$mime} or return;
4016	my $old = $self->{VALUE}->{MIMEType};
4017	if (defined $old) {
4018	my ($a, $b) = split '/', $old;
4019	my ($c, $d) = split '/', $mime;
4020	$d =~ s/^x-//;
4021	$self->{VALUE}->{MIMEType} = "$c/$b-$d";
4022	$self->VPrint(0, " Modified MIMEType = $c/$b-$d\n");
4023	} else {
4024	$self->FoundTag('MIMEType', $mime);
4025	}
4026	}
4027
4028	#------------------------------------------------------------------------------
4029	# Print verbose output
4030	# Inputs: 0) ExifTool ref, 1) verbose level (prints if level > this), 2-N) print args
4031	sub VPrint($$@)
4032	{
4033	my $self = shift;
4034	my $level = shift;
4035	if ($self->{OPTIONS}->{Verbose} and $self->{OPTIONS}->{Verbose} > $level) {
4036	my $out = $self->{OPTIONS}->{TextOut};
4037	print $out @_;
4038	}
4039	}
4040
4041	#------------------------------------------------------------------------------
4042	# Verbose dump
4043	# Inputs: 0) ExifTool ref, 1) data ref, 2-N) HexDump options
4044	sub VerboseDump($$;%)
4045	{
4046	my $self = shift;
4047	my $dataPt = shift;
4048	if ($self->{OPTIONS}->{Verbose} and $self->{OPTIONS}->{Verbose} > 2) {
4049	HexDump($dataPt, undef,
4050	Out => $self->{OPTIONS}->{TextOut},
4051	MaxLen => $self->{OPTIONS}->{Verbose} < 4 ? 96 : undef,
4052	@_
4053	);
4054	}
4055	}
4056
4057	#------------------------------------------------------------------------------
4058	# Extract binary data from file
4059	# 0) ExifTool object reference, 1) offset, 2) length, 3) tag name if conditional
4060	# Returns: binary data, or undef on error
4061	# Notes: Returns "Binary data #### bytes" instead of data unless tag is
4062	# specifically requested or the Binary option is set
4063	sub ExtractBinary($$$;$)
4064	{
4065	my ($self, $offset, $length, $tag) = @_;
4066
4067	if ($tag and not $self->{OPTIONS}->{Binary} and
4068	not $self->{REQ_TAG_LOOKUP}->{lc($tag)})
4069	{
4070	return "Binary data $length bytes";
4071	}
4072	my $buff;
4073	unless ($self->{RAF}->Seek($offset,0)
4074	and $self->{RAF}->Read($buff, $length) == $length)
4075	{
4076	$tag or $tag = 'binary data';
4077	$self->Warn("Error reading $tag from file");
4078	return undef;
4079	}
4080	return $buff;
4081	}
4082
4083	#------------------------------------------------------------------------------
4084	# Process binary data
4085	# Inputs: 0) ExifTool object reference, 1) directory information reference
4086	# 2) tag table reference
4087	# Returns: 1 on success
4088	sub ProcessBinaryData($$$)
4089	{
4090	my ($self, $dirInfo, $tagTablePtr) = @_;
4091	my $dataPt = $$dirInfo{DataPt};
4092	my $offset = $$dirInfo{DirStart} \|\| 0;
4093	my $size = $$dirInfo{DirLen} \|\| (length($$dataPt) - $offset);
4094	my $base = $$dirInfo{Base} \|\| 0;
4095	my $verbose = $self->{OPTIONS}->{Verbose};
4096	my $unknown = $self->{OPTIONS}->{Unknown};
4097	my $dataPos;
4098
4099	# get default format ('int8u' unless specified)
4100	my $defaultFormat = $$tagTablePtr{FORMAT} \|\| 'int8u';
4101	my $increment = $formatSize{$defaultFormat};
4102	unless ($increment) {
4103	warn "Unknown format $defaultFormat\n";
4104	$defaultFormat = 'int8u';
4105	$increment = $formatSize{$defaultFormat};
4106	}
4107	# prepare list of tag numbers to extract
4108	my @tags;
4109	if ($unknown > 1 and defined $$tagTablePtr{FIRST_ENTRY}) {
4110	# scan through entire binary table
4111	@tags = ($$tagTablePtr{FIRST_ENTRY}..(int($size/$increment) - 1));
4112	} elsif ($$dirInfo{DataMember}) {
4113	@tags = @{$$dirInfo{DataMember}};
4114	$verbose = 0; # no verbose output of extracted values when writing
4115	} else {
4116	# extract known tags in numerical order
4117	@tags = sort { $a <=> $b } TagTableKeys($tagTablePtr);
4118	}
4119	if ($verbose) {
4120	$self->VerboseDir('BinaryData', undef, $size);
4121	$dataPos = $$dirInfo{DataPos} \|\| 0;
4122	}
4123	my $index;
4124	my $nextIndex = 0;
4125	my %val;
4126	foreach $index (@tags) {
4127	my $tagInfo;
4128	if ($$tagTablePtr{$index}) {
4129	$tagInfo = $self->GetTagInfo($tagTablePtr, $index) or next;
4130	next if $$tagInfo{Unknown} and
4131	($$tagInfo{Unknown} > $unknown or $index < $nextIndex);
4132	} else {
4133	# don't generate unknown tags in binary tables unless Unknown > 1
4134	next unless $unknown > 1;
4135	next if $index < $nextIndex; # skip if data already used
4136	$tagInfo = $self->GetTagInfo($tagTablePtr, $index) or next;
4137	$$tagInfo{Unknown} = 2; # set unknown to 2 for binary unknowns
4138	}
4139	my $count = 1;
4140	my $format = $$tagInfo{Format};
4141	my $entry = $index * $increment; # relative offset of this entry
4142	if ($format) {
4143	if ($format =~ /(.)\[(.)\]/) {
4144	$format = $1;
4145	$count = $2;
4146	# evaluate count to allow count to be based on previous values
4147	#### eval Format (%val, $size)
4148	$count = eval $count;
4149	$@ and warn("Format $$tagInfo{Name}: $@"), next;
4150	next if $count < 0;
4151	} elsif ($format eq 'string') {
4152	# allow string with no specified count to run to end of block
4153	$count = ($size > $entry) ? $size - $entry : 0;
4154	}
4155	} else {
4156	$format = $defaultFormat;
4157	}
4158	if ($unknown > 1) {
4159	# calculate next valid index for unknown tag
4160	my $ni = $index + ($formatSize{$format} * $count) / $increment;
4161	$nextIndex = $ni unless $nextIndex > $ni;
4162	}
4163	my $val = ReadValue($dataPt, $entry+$offset, $format, $count, $size-$entry);
4164	next unless defined $val;
4165	if ($verbose) {
4166	my $len = $count * ($formatSize{$format} \|\| 1);
4167	$len > $size - $entry and $len = $size - $entry;
4168	$self->VerboseInfo($index, $tagInfo,
4169	Table => $tagTablePtr,
4170	Value => $val,
4171	DataPt => $dataPt,
4172	Size => $len,
4173	Start => $entry+$offset,
4174	Addr => $entry+$offset+$base+$dataPos,
4175	Format => $format,
4176	Count => $count,
4177	);
4178	}
4179	$val += $base + $$self{BASE} if $$tagInfo{IsOffset};
4180	$val{$index} = $val;
4181	$self->FoundTag($tagInfo,$val);
4182	}
4183	return 1;
4184	}
4185
4186	#..............................................................................
4187	# Load .ExifTool_config file from user's home directory (unless 'noConfig' set)
4188	unless ($Image::ExifTool::noConfig) {
4189	my $config = '.ExifTool_config';
4190	# get our home directory (HOMEDRIVE and HOMEPATH are used in Windows cmd shell)
4191	my $home = $ENV{EXIFTOOL_HOME} \|\| $ENV{HOME} \|\|
4192	($ENV{HOMEDRIVE} \|\| '') . ($ENV{HOMEPATH} \|\| '') \|\| '.';
4193	# look for the config file in 1) the home directory, 2) the program dir
4194	my $file = "$home/$config";
4195	-r $file or $file = ($0 =~ /(.*[\\\/])/ ? $1 : './') . $config;
4196	if (-r $file) {
4197	eval "require '$file'"; # load the config file
4198	# print warning (minus "Compilation failed" part)
4199	$@ and $_=$@, s/Compilation failed.*//s, warn $_;
4200	}
4201	}
4202
4203	#------------------------------------------------------------------------------
4204	1; # end

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

Download in other formats: