1#------------------------------------------------------------------------------ 2# File: ExifTool.pm 3# 4# Description: Read and write meta information 5# 6# URL: https://exiftool.org/ 7# 8# Revisions: Nov. 12/2003 - P. Harvey Created 9# (See html/history.html for revision history) 10# 11# Legal: Copyright (c) 2003-2021, Phil Harvey (philharvey66 at gmail.com) 12# This library is free software; you can redistribute it and/or 13# modify it under the same terms as Perl itself. 14#------------------------------------------------------------------------------ 15 16package Image::ExifTool; 17 18use strict; 19require 5.004; # require 5.004 for UNIVERSAL::isa (otherwise 5.002 would do) 20require Exporter; 21use File::RandomAccess; 22use overload; 23 24use vars qw($VERSION $RELEASE @ISA @EXPORT_OK %EXPORT_TAGS $AUTOLOAD @fileTypes 25 %allTables @tableOrder $exifAPP1hdr $xmpAPP1hdr $xmpExtAPP1hdr 26 $psAPP13hdr $psAPP13old @loadAllTables %UserDefined $evalWarning 27 %noWriteFile %magicNumber @langs $defaultLang %langName %charsetName 28 %mimeType $swapBytes $swapWords $currentByteOrder %unpackStd 29 %jpegMarker %specialTags %fileTypeLookup $testLen $exePath); 30 31$VERSION = '12.14'; 32$RELEASE = ''; 33@ISA = qw(Exporter); 34%EXPORT_TAGS = ( 35 # all public non-object-oriented functions: 36 Public => [qw( 37 ImageInfo GetTagName GetShortcuts GetAllTags GetWritableTags 38 GetAllGroups GetDeleteGroups GetFileType CanWrite CanCreate 39 AddUserDefinedTags 40 )], 41 # exports not part of the public API, but used by ExifTool modules: 42 DataAccess => [qw( 43 ReadValue GetByteOrder SetByteOrder ToggleByteOrder Get8u Get8s Get16u 44 Get16s Get32u Get32s Get64u GetFloat GetDouble GetFixed32s Write 45 WriteValue Tell Set8u Set8s Set16u Set32u Set64u 46 )], 47 Utils => [qw(GetTagTable TagTableKeys GetTagInfoList AddTagToTable HexDump)], 48 Vars => [qw(%allTables @tableOrder @fileTypes)], 49); 50 51# set all of our EXPORT_TAGS in EXPORT_OK 52Exporter::export_ok_tags(keys %EXPORT_TAGS); 53 54# test for problems that can arise if encoding.pm is used 55{ my $t = "\xff"; die "Incompatible encoding!\n" if ord($t) != 0xff; } 56 57# The following functions defined in Image::ExifTool::Writer.pl are declared 58# here so their prototypes will be available. These Writer routines will be 59# autoloaded when any of them is called. 60sub SetNewValue($;$$%); 61sub SetNewValuesFromFile($$;@); 62sub GetNewValue($$;$); 63sub GetNewValues($$;$); 64sub CountNewValues($); 65sub SaveNewValues($); 66sub RestoreNewValues($); 67sub WriteInfo($$;$$); 68sub SetFileModifyDate($$;$$$); 69sub SetFileName($$;$$$); 70sub SetSystemTags($$); 71sub GetAllTags(;$); 72sub GetWritableTags(;$); 73sub GetAllGroups($); 74sub GetNewGroups($); 75sub GetDeleteGroups(); 76sub AddUserDefinedTags($%); 77# non-public routines below 78sub InsertTagValues($$$;$$$); 79sub IsWritable($); 80sub IsSameFile($$$); 81sub IsRawType($); 82sub GetNewFileName($$); 83sub LoadAllTables(); 84sub GetNewTagInfoList($;$); 85sub GetNewTagInfoHash($@); 86sub GetLangInfo($$); 87sub Get64s($$); 88sub Get64u($$); 89sub GetFixed64s($$); 90sub GetExtended($$); 91sub Set64u(@); 92sub DecodeBits($$;$); 93sub EncodeBits($$;$$); 94sub Filter($$$); 95sub HexDump($;$%); 96sub DumpTrailer($$); 97sub DumpUnknownTrailer($$); 98sub VerboseInfo($$$%); 99sub VerboseValue($$$;$); 100sub VPrint($$@); 101sub Rationalize($;$); 102sub Write($@); 103sub WriteTrailerBuffer($$$); 104sub AddNewTrailers($;@); 105sub Tell($); 106sub WriteValue($$;$$$$); 107sub WriteDirectory($$$;$); 108sub WriteBinaryData($$$); 109sub CheckBinaryData($$$); 110sub WriteTIFF($$$); 111sub PackUTF8(@); 112sub UnpackUTF8($); 113sub SetPreferredByteOrder($;$); 114sub CopyBlock($$$); 115sub CopyFileAttrs($$$); 116sub TimeNow(;$$); 117sub NewGUID(); 118sub MakeTiffHeader($$$$;$$); 119 120# other subroutine definitions 121sub SplitFileName($); 122sub EncodeFileName($$;$); 123sub Open($*$;$); 124sub Exists($$); 125sub IsDirectory($$); 126sub Rename($$$); 127sub Unlink($@); 128sub SetFileTime($$;$$$$); 129sub DoEscape($$); 130sub ConvertFileSize($); 131sub ParseArguments($;@); #(defined in attempt to avoid mod_perl problem) 132sub ReadValue($$$;$$$); 133 134# list of main tag tables to load in LoadAllTables() (sub-tables are recursed 135# automatically). Note: They will appear in this order in the documentation 136# unless tweaked in BuildTagLookup::GetTableOrder(). 137@loadAllTables = qw( 138 PhotoMechanic Exif GeoTiff CanonRaw KyoceraRaw Lytro MinoltaRaw PanasonicRaw 139 SigmaRaw JPEG GIMP Jpeg2000 GIF BMP BMP::OS2 BMP::Extra BPG BPG::Extensions 140 PICT PNG MNG FLIF DjVu DPX OpenEXR ZISRAW MIFF PCX PGF PSP PhotoCD Radiance 141 PDF PostScript Photoshop::Header Photoshop::Layers Photoshop::ImageData 142 FujiFilm::RAF FujiFilm::IFD Samsung::Trailer Sony::SRF2 Sony::SR2SubIFD 143 Sony::PMP ITC ID3 ID3::Lyrics3 FLAC Ogg Vorbis APE APE::NewHeader 144 APE::OldHeader Audible MPC MPEG::Audio MPEG::Video MPEG::Xing M2TS QuickTime 145 QuickTime::ImageFile QuickTime::Stream QuickTime::Tags360Fly Matroska MOI 146 MXF DV Flash Flash::FLV Real::Media Real::Audio Real::Metafile Red RIFF AIFF 147 ASF WTV DICOM FITS MIE JSON HTML XMP::SVG Palm Palm::MOBI Palm::EXTH Torrent 148 EXE EXE::PEVersion EXE::PEString EXE::MachO EXE::PEF EXE::ELF EXE::AR 149 EXE::CHM LNK Font VCard Text VCard::VCalendar RSRC Rawzor ZIP ZIP::GZIP 150 ZIP::RAR RTF OOXML iWork ISO FLIR::AFF FLIR::FPF MacOS MacOS::MDItem 151 FlashPix::DocTable 152); 153 154# alphabetical list of current Lang modules 155@langs = qw(cs de en en_ca en_gb es fi fr it ja ko nl pl ru sv tr zh_cn zh_tw); 156 157$defaultLang = 'en'; # default language 158 159# language names 160%langName = ( 161 cs => 'Czech (Čeština)', 162 de => 'German (Deutsch)', 163 en => 'English', 164 en_ca => 'Canadian English', 165 en_gb => 'British English', 166 es => 'Spanish (Español)', 167 fi => 'Finnish (Suomi)', 168 fr => 'French (Français)', 169 it => 'Italian (Italiano)', 170 ja => 'Japanese (日本語)', 171 ko => 'Korean (한국어)', 172 nl => 'Dutch (Nederlands)', 173 pl => 'Polish (Polski)', 174 ru => 'Russian (Русский)', 175 sv => 'Swedish (Svenska)', 176 'tr'=> 'Turkish (Türkçe)', 177 zh_cn => 'Simplified Chinese (简体中文)', 178 zh_tw => 'Traditional Chinese (繁體中文)', 179); 180 181# recognized file types, in the order we test unknown files 182# Notes: 1) There is no need to test for like types separately here 183# 2) Put types with weak file signatures at end of list to avoid false matches 184# 3) PLIST must be in this list for the binary PLIST format, although it may 185# cause a file to be checked twice for XML 186@fileTypes = qw(JPEG EXV CRW DR4 TIFF GIF MRW RAF X3F JP2 PNG MIE MIFF PS PDF 187 PSD XMP BMP BPG PPM RIFF AIFF ASF MOV MPEG Real SWF PSP FLV OGG 188 FLAC APE MPC MKV MXF DV PMP IND PGF ICC ITC FLIR FLIF FPF LFP 189 HTML VRD RTF FITS XCF DSS QTIF FPX PICT ZIP GZIP PLIST RAR BZ2 190 CZI TAR EXE EXR HDR CHM LNK WMF AVC DEX DPX RAW Font RSRC M2TS 191 MacOS PHP PCX DCX DWF DWG WTV Torrent VCard LRI R3D AA PDB MOI 192 ISO ALIAS JSON MP3 DICOM PCD TXT); 193 194# file types that we can write (edit) 195my @writeTypes = qw(JPEG TIFF GIF CRW MRW ORF RAF RAW PNG MIE PSD XMP PPM EPS 196 X3F PS PDF ICC VRD DR4 JP2 EXIF AI AIT IND MOV EXV FLIF); 197my %writeTypes; # lookup for writable file types (hash filled if required) 198 199# file extensions that we can't write for various base types 200%noWriteFile = ( 201 TIFF => [ qw(3FR DCR K25 KDC SRF) ], 202 XMP => [ qw(SVG INX) ], 203 JP2 => [ qw(J2C JPC) ], 204 MOV => [ qw(INSV) ], 205); 206 207# file types that we can create from scratch 208# - must update CanCreate() documentation if this list is changed! 209my %createTypes = map { $_ => 1 } qw(XMP ICC MIE VRD DR4 EXIF EXV); 210 211# file type lookup for all recognized file extensions (upper case) 212# (if extension may be more than one type, the type is a list where 213# the writable type should come first if it exists) 214%fileTypeLookup = ( 215 '360' => ['MOV', 'GoPro 360 video'], 216 '3FR' => ['TIFF', 'Hasselblad RAW format'], 217 '3G2' => ['MOV', '3rd Gen. Partnership Project 2 audio/video'], 218 '3GP' => ['MOV', '3rd Gen. Partnership Project audio/video'], 219 '3GP2'=> '3G2', 220 '3GPP'=> '3GP', 221 A => ['EXE', 'Static library'], 222 AA => ['AA', 'Audible Audiobook'], 223 AAE => ['PLIST','Apple edit information'], 224 AAX => ['MOV', 'Audible Enhanced Audiobook'], 225 ACR => ['DICOM','American College of Radiology ACR-NEMA'], 226 ACFM => ['Font', 'Adobe Composite Font Metrics'], 227 AFM => ['Font', 'Adobe Font Metrics'], 228 AMFM => ['Font', 'Adobe Multiple Master Font Metrics'], 229 AI => [['PDF','PS'], 'Adobe Illustrator'], 230 AIF => 'AIFF', 231 AIFC => ['AIFF', 'Audio Interchange File Format Compressed'], 232 AIFF => ['AIFF', 'Audio Interchange File Format'], 233 AIT => 'AI', 234 ALIAS=> ['ALIAS','MacOS file alias'], 235 APE => ['APE', "Monkey's Audio format"], 236 APNG => ['PNG', 'Animated Portable Network Graphics'], 237 ARW => ['TIFF', 'Sony Alpha RAW format'], 238 ARQ => ['TIFF', 'Sony Alpha Pixel-Shift RAW format'], 239 ASF => ['ASF', 'Microsoft Advanced Systems Format'], 240 AVC => ['AVC', 'Advanced Video Connection'], # (extensions are actually _AU,_AD,_IM,_ID) 241 AVI => ['RIFF', 'Audio Video Interleaved'], 242 AVIF => ['MOV', 'AV1 Image File Format'], 243 AZW => 'MOBI', # (see http://wiki.mobileread.com/wiki/AZW) 244 AZW3 => 'MOBI', 245 BMP => ['BMP', 'Windows Bitmap'], 246 BPG => ['BPG', 'Better Portable Graphics'], 247 BTF => ['BTF', 'Big Tagged Image File Format'], #(unofficial) 248 BZ2 => ['BZ2', 'BZIP2 archive'], 249 CHM => ['CHM', 'Microsoft Compiled HTML format'], 250 CIFF => ['CRW', 'Camera Image File Format'], 251 COS => ['COS', 'Capture One Settings'], 252 CR2 => ['TIFF', 'Canon RAW 2 format'], 253 CR3 => ['MOV', 'Canon RAW 3 format'], 254 CRM => ['MOV', 'Canon RAW Movie'], 255 CRW => ['CRW', 'Canon RAW format'], 256 CS1 => ['PSD', 'Sinar CaptureShop 1-Shot RAW'], 257 CSV => ['TXT', 'Comma-Separated Values'], 258 CZI => ['CZI', 'Zeiss Integrated Software RAW'], 259 DC3 => 'DICM', 260 DCM => 'DICM', 261 DCP => ['TIFF', 'DNG Camera Profile'], 262 DCR => ['TIFF', 'Kodak Digital Camera RAW'], 263 DCX => ['DCX', 'Multi-page PC Paintbrush'], 264 DEX => ['DEX', 'Dalvik Executable format'], 265 DFONT=> ['Font', 'Macintosh Data fork Font'], 266 DIB => ['BMP', 'Device Independent Bitmap'], 267 DIC => 'DICM', 268 DICM => ['DICOM','Digital Imaging and Communications in Medicine'], 269 DIVX => ['ASF', 'DivX media format'], 270 DJV => 'DJVU', 271 DJVU => ['AIFF', 'DjVu image'], 272 DLL => ['EXE', 'Windows Dynamic Link Library'], 273 DNG => ['TIFF', 'Digital Negative'], 274 DOC => ['FPX', 'Microsoft Word Document'], 275 DOCM => [['ZIP','FPX'], 'Office Open XML Document Macro-enabled'], 276 # Note: I have seen a password-protected DOCX file which was FPX-like, so I assume 277 # that any other MS Office file could be like this too. The only difference is 278 # that the ZIP and FPX formats are checked first, so if this is wrong, no biggie. 279 DOCX => [['ZIP','FPX'], 'Office Open XML Document'], 280 DOT => ['FPX', 'Microsoft Word Template'], 281 DOTM => [['ZIP','FPX'], 'Office Open XML Document Template Macro-enabled'], 282 DOTX => [['ZIP','FPX'], 'Office Open XML Document Template'], 283 DPX => ['DPX', 'Digital Picture Exchange' ], 284 DR4 => ['DR4', 'Canon VRD version 4 Recipe'], 285 DS2 => ['DSS', 'Digital Speech Standard 2'], 286 DSS => ['DSS', 'Digital Speech Standard'], 287 DV => ['DV', 'Digital Video'], 288 DVB => ['MOV', 'Digital Video Broadcasting'], 289 'DVR-MS'=>['ASF', 'Microsoft Digital Video recording'], 290 DWF => ['DWF', 'Autodesk drawing (Design Web Format)'], 291 DWG => ['DWG', 'AutoCAD Drawing'], 292 DYLIB=> ['EXE', 'Mach-O Dynamic Link Library'], 293 EIP => ['ZIP', 'Capture One Enhanced Image Package'], 294 EPS => ['EPS', 'Encapsulated PostScript Format'], 295 EPS2 => 'EPS', 296 EPS3 => 'EPS', 297 EPSF => 'EPS', 298 EPUB => ['ZIP', 'Electronic Publication'], 299 ERF => ['TIFF', 'Epson Raw Format'], 300 EXE => ['EXE', 'Windows executable file'], 301 EXR => ['EXR', 'Open EXR'], 302 EXIF => ['EXIF', 'Exchangable Image File Metadata'], 303 EXV => ['EXV', 'Exiv2 metadata'], 304 F4A => ['MOV', 'Adobe Flash Player 9+ Audio'], 305 F4B => ['MOV', 'Adobe Flash Player 9+ audio Book'], 306 F4P => ['MOV', 'Adobe Flash Player 9+ Protected'], 307 F4V => ['MOV', 'Adobe Flash Player 9+ Video'], 308 FFF => [['TIFF','FLIR'], 'Hasselblad Flexible File Format'], 309 FIT => 'FITS', 310 FITS => ['FITS', 'Flexible Image Transport System'], 311 FLAC => ['FLAC', 'Free Lossless Audio Codec'], 312 FLA => ['FPX', 'Macromedia/Adobe Flash project'], 313 FLIF => ['FLIF', 'Free Lossless Image Format'], 314 FLIR => ['FLIR', 'FLIR File Format'], # (not an actual extension) 315 FLV => ['FLV', 'Flash Video'], 316 FPF => ['FPF', 'FLIR Public image Format'], 317 FPX => ['FPX', 'FlashPix'], 318 GIF => ['GIF', 'Compuserve Graphics Interchange Format'], 319 GPR => ['TIFF', 'GoPro RAW'], 320 GZ => 'GZIP', 321 GZIP => ['GZIP', 'GNU ZIP compressed archive'], 322 HDP => ['TIFF', 'Windows HD Photo'], 323 HDR => ['HDR', 'Radiance RGBE High Dynamic Range'], 324 HEIC => ['MOV', 'High Efficiency Image Format still image'], 325 HEIF => ['MOV', 'High Efficiency Image Format'], 326 HIF => 'HEIF', 327 HTM => 'HTML', 328 HTML => ['HTML', 'HyperText Markup Language'], 329 ICAL => 'ICS', 330 ICC => ['ICC', 'International Color Consortium'], 331 ICM => 'ICC', 332 ICS => ['VCard','iCalendar Schedule'], 333 IDML => ['ZIP', 'Adobe InDesign Markup Language'], 334 IIQ => ['TIFF', 'Phase One Intelligent Image Quality RAW'], 335 IND => ['IND', 'Adobe InDesign'], 336 INDD => ['IND', 'Adobe InDesign Document'], 337 INDT => ['IND', 'Adobe InDesign Template'], 338 INSV => ['MOV', 'Insta360 Video'], 339 INSP => ['JPEG', 'Insta360 Picture'], 340 INX => ['XMP', 'Adobe InDesign Interchange'], 341 ISO => ['ISO', 'ISO 9660 disk image'], 342 ITC => ['ITC', 'iTunes Cover Flow'], 343 J2C => ['JP2', 'JPEG 2000 codestream'], 344 J2K => 'J2C', 345 JNG => ['PNG', 'JPG Network Graphics'], 346 JP2 => ['JP2', 'JPEG 2000 file'], 347 # JP4? - looks like a JPEG but the image data is different 348 JPC => 'J2C', 349 JPE => 'JPEG', 350 JPEG => ['JPEG', 'Joint Photographic Experts Group'], 351 JPF => 'JP2', 352 JPG => 'JPEG', 353 JPM => ['JP2', 'JPEG 2000 compound image'], 354 JPX => ['JP2', 'JPEG 2000 with extensions'], 355 JSON => ['JSON', 'JavaScript Object Notation'], 356 JXR => ['TIFF', 'JPEG XR'], 357 K25 => ['TIFF', 'Kodak DC25 RAW'], 358 KDC => ['TIFF', 'Kodak Digital Camera RAW'], 359 KEY => ['ZIP', 'Apple Keynote presentation'], 360 KTH => ['ZIP', 'Apple Keynote Theme'], 361 LA => ['RIFF', 'Lossless Audio'], 362 LFP => ['LFP', 'Lytro Light Field Picture'], 363 LFR => 'LFP', # (Light Field RAW) 364 LNK => ['LNK', 'Windows shortcut'], 365 LRI => ['LRI', 'Light RAW'], 366 LRV => ['MOV', 'Low-Resolution Video'], 367 M2T => 'M2TS', 368 M2TS => ['M2TS', 'MPEG-2 Transport Stream'], 369 M2V => ['MPEG', 'MPEG-2 Video'], 370 M4A => ['MOV', 'MPEG-4 Audio'], 371 M4B => ['MOV', 'MPEG-4 audio Book'], 372 M4P => ['MOV', 'MPEG-4 Protected'], 373 M4V => ['MOV', 'MPEG-4 Video'], 374 MAX => ['FPX', '3D Studio MAX'], 375 MEF => ['TIFF', 'Mamiya (RAW) Electronic Format'], 376 MIE => ['MIE', 'Meta Information Encapsulation format'], 377 MIF => 'MIFF', 378 MIFF => ['MIFF', 'Magick Image File Format'], 379 MKA => ['MKV', 'Matroska Audio'], 380 MKS => ['MKV', 'Matroska Subtitle'], 381 MKV => ['MKV', 'Matroska Video'], 382 MNG => ['PNG', 'Multiple-image Network Graphics'], 383 MOBI => ['PDB', 'Mobipocket electronic book'], 384 MODD => ['PLIST','Sony Picture Motion metadata'], 385 MOI => ['MOI', 'MOD Information file'], 386 MOS => ['TIFF', 'Creo Leaf Mosaic'], 387 MOV => ['MOV', 'Apple QuickTime movie'], 388 MP3 => ['MP3', 'MPEG-1 Layer 3 audio'], 389 MP4 => ['MOV', 'MPEG-4 video'], 390 MPC => ['MPC', 'Musepack Audio'], 391 MPEG => ['MPEG', 'MPEG-1 or MPEG-2 audio/video'], 392 MPG => 'MPEG', 393 MPO => ['JPEG', 'Extended Multi-Picture format'], 394 MQV => ['MOV', 'Sony Mobile Quicktime Video'], 395 MRW => ['MRW', 'Minolta RAW format'], 396 MTS => 'M2TS', 397 MXF => ['MXF', 'Material Exchange Format'], 398 # NDPI => ['TIFF', 'Hamamatsu NanoZoomer Digital Pathology Image'], 399 NEF => ['TIFF', 'Nikon (RAW) Electronic Format'], 400 NEWER => 'COS', 401 NMBTEMPLATE => ['ZIP','Apple Numbers Template'], 402 NRW => ['TIFF', 'Nikon RAW (2)'], 403 NUMBERS => ['ZIP','Apple Numbers spreadsheet'], 404 O => ['EXE', 'Relocatable Object'], 405 ODB => ['ZIP', 'Open Document Database'], 406 ODC => ['ZIP', 'Open Document Chart'], 407 ODF => ['ZIP', 'Open Document Formula'], 408 ODG => ['ZIP', 'Open Document Graphics'], 409 ODI => ['ZIP', 'Open Document Image'], 410 ODP => ['ZIP', 'Open Document Presentation'], 411 ODS => ['ZIP', 'Open Document Spreadsheet'], 412 ODT => ['ZIP', 'Open Document Text file'], 413 OFR => ['RIFF', 'OptimFROG audio'], 414 OGG => ['OGG', 'Ogg Vorbis audio file'], 415 OGV => ['OGG', 'Ogg Video file'], 416 ONP => ['JSON', 'ON1 Presets'], 417 OPUS => ['OGG', 'Ogg Opus audio file'], 418 ORF => ['ORF', 'Olympus RAW format'], 419 OTF => ['Font', 'Open Type Font'], 420 PAC => ['RIFF', 'Lossless Predictive Audio Compression'], 421 PAGES => ['ZIP', 'Apple Pages document'], 422 PBM => ['PPM', 'Portable BitMap'], 423 PCD => ['PCD', 'Kodak Photo CD Image Pac'], 424 PCT => 'PICT', 425 PCX => ['PCX', 'PC Paintbrush'], 426 PDB => ['PDB', 'Palm Database'], 427 PDF => ['PDF', 'Adobe Portable Document Format'], 428 PEF => ['TIFF', 'Pentax (RAW) Electronic Format'], 429 PFA => ['Font', 'PostScript Font ASCII'], 430 PFB => ['Font', 'PostScript Font Binary'], 431 PFM => ['Font', 'Printer Font Metrics'], 432 PGF => ['PGF', 'Progressive Graphics File'], 433 PGM => ['PPM', 'Portable Gray Map'], 434 PHP => ['PHP', 'PHP Hypertext Preprocessor'], 435 PHP3 => 'PHP', 436 PHP4 => 'PHP', 437 PHP5 => 'PHP', 438 PHPS => 'PHP', 439 PHTML=> 'PHP', 440 PICT => ['PICT', 'Apple PICTure'], 441 PLIST=> ['PLIST','Apple Property List'], 442 PMP => ['PMP', 'Sony DSC-F1 Cyber-Shot PMP'], # should stand for Proprietery Metadata Package ;) 443 PNG => ['PNG', 'Portable Network Graphics'], 444 POT => ['FPX', 'Microsoft PowerPoint Template'], 445 POTM => [['ZIP','FPX'], 'Office Open XML Presentation Template Macro-enabled'], 446 POTX => [['ZIP','FPX'], 'Office Open XML Presentation Template'], 447 PPAM => [['ZIP','FPX'], 'Office Open XML Presentation Addin Macro-enabled'], 448 PPAX => [['ZIP','FPX'], 'Office Open XML Presentation Addin'], 449 PPM => ['PPM', 'Portable Pixel Map'], 450 PPS => ['FPX', 'Microsoft PowerPoint Slideshow'], 451 PPSM => [['ZIP','FPX'], 'Office Open XML Presentation Slideshow Macro-enabled'], 452 PPSX => [['ZIP','FPX'], 'Office Open XML Presentation Slideshow'], 453 PPT => ['FPX', 'Microsoft PowerPoint Presentation'], 454 PPTM => [['ZIP','FPX'], 'Office Open XML Presentation Macro-enabled'], 455 PPTX => [['ZIP','FPX'], 'Office Open XML Presentation'], 456 PRC => ['PDB', 'Palm Database'], 457 PS => ['PS', 'PostScript'], 458 PS2 => 'PS', 459 PS3 => 'PS', 460 PSB => ['PSD', 'Photoshop Large Document'], 461 PSD => ['PSD', 'Photoshop Document'], 462 PSDT => ['PSD', 'Photoshop Document Template'], 463 PSP => ['PSP', 'Paint Shop Pro'], 464 PSPFRAME => 'PSP', 465 PSPIMAGE => 'PSP', 466 PSPSHAPE => 'PSP', 467 PSPTUBE => 'PSP', 468 QIF => 'QTIF', 469 QT => 'MOV', 470 QTI => 'QTIF', 471 QTIF => ['QTIF', 'QuickTime Image File'], 472 R3D => ['R3D', 'Redcode RAW Video'], 473 RA => ['Real', 'Real Audio'], 474 RAF => ['RAF', 'FujiFilm RAW Format'], 475 RAM => ['Real', 'Real Audio Metafile'], 476 RAR => ['RAR', 'RAR Archive'], 477 RAW => [['RAW','TIFF'], 'Kyocera Contax N Digital RAW or Panasonic RAW'], 478 RIF => 'RIFF', 479 RIFF => ['RIFF', 'Resource Interchange File Format'], 480 RM => ['Real', 'Real Media'], 481 RMVB => ['Real', 'Real Media Variable Bitrate'], 482 RPM => ['Real', 'Real Media Plug-in Metafile'], 483 RSRC => ['RSRC', 'Mac OS Resource'], 484 RTF => ['RTF', 'Rich Text Format'], 485 RV => ['Real', 'Real Video'], 486 RW2 => ['TIFF', 'Panasonic RAW 2'], 487 RWL => ['TIFF', 'Leica RAW'], 488 RWZ => ['RWZ', 'Rawzor compressed image'], 489 SEQ => ['FLIR', 'FLIR image Sequence'], 490 SKETCH => ['ZIP', 'Sketch design file'], 491 SO => ['EXE', 'Shared Object file'], 492 SR2 => ['TIFF', 'Sony RAW Format 2'], 493 SRF => ['TIFF', 'Sony RAW Format'], 494 SRW => ['TIFF', 'Samsung RAW format'], 495 SVG => ['XMP', 'Scalable Vector Graphics'], 496 SWF => ['SWF', 'Shockwave Flash'], 497 TAR => ['TAR', 'TAR archive'], 498 THM => ['JPEG', 'Thumbnail'], 499 THMX => [['ZIP','FPX'], 'Office Open XML Theme'], 500 TIF => 'TIFF', 501 TIFF => ['TIFF', 'Tagged Image File Format'], 502 TORRENT => ['Torrent', 'BitTorrent description file'], 503 TS => 'M2TS', 504 TTC => ['Font', 'True Type Font Collection'], 505 TTF => ['Font', 'True Type Font'], 506 TUB => 'PSP', 507 TXT => ['TXT', 'Text file'], 508 VCARD=> ['VCard','Virtual Card'], 509 VCF => 'VCARD', 510 VOB => ['MPEG', 'Video Object'], 511 VRD => ['VRD', 'Canon VRD Recipe Data'], 512 VSD => ['FPX', 'Microsoft Visio Drawing'], 513 WAV => ['RIFF', 'WAVeform (Windows digital audio)'], 514 WDP => ['TIFF', 'Windows Media Photo'], 515 WEBM => ['MKV', 'Google Web Movie'], 516 WEBP => ['RIFF', 'Google Web Picture'], 517 WMA => ['ASF', 'Windows Media Audio'], 518 WMF => ['WMF', 'Windows Metafile Format'], 519 WMV => ['ASF', 'Windows Media Video'], 520 WV => ['RIFF', 'WavePack lossless audio'], 521 X3F => ['X3F', 'Sigma RAW format'], 522 MACOS=> ['MacOS','MacOS ._ sidecar file'], 523 XCF => ['XCF', 'GIMP native image format'], 524 XHTML=> ['HTML', 'Extensible HyperText Markup Language'], 525 XLA => ['FPX', 'Microsoft Excel Add-in'], 526 XLAM => [['ZIP','FPX'], 'Office Open XML Spreadsheet Add-in Macro-enabled'], 527 XLS => ['FPX', 'Microsoft Excel Spreadsheet'], 528 XLSB => [['ZIP','FPX'], 'Office Open XML Spreadsheet Binary'], 529 XLSM => [['ZIP','FPX'], 'Office Open XML Spreadsheet Macro-enabled'], 530 XLSX => [['ZIP','FPX'], 'Office Open XML Spreadsheet'], 531 XLT => ['FPX', 'Microsoft Excel Template'], 532 XLTM => [['ZIP','FPX'], 'Office Open XML Spreadsheet Template Macro-enabled'], 533 XLTX => [['ZIP','FPX'], 'Office Open XML Spreadsheet Template'], 534 XMP => ['XMP', 'Extensible Metadata Platform'], 535 WOFF => ['Font', 'Web Open Font Format'], 536 WOFF2=> ['Font', 'Web Open Font Format2'], 537 WTV => ['WTV', 'Windows recorded TV show'], 538 ZIP => ['ZIP', 'ZIP archive'], 539); 540 541# typical extension for each file type (if different than FileType) 542# - case is not significant 543my %fileTypeExt = ( 544 'Canon 1D RAW' => 'tif', 545 DICOM => 'dcm', 546 FLIR => 'fff', 547 GZIP => 'gz', 548 JPEG => 'jpg', 549 M2TS => 'mts', 550 MPEG => 'mpg', 551 TIFF => 'tif', 552 VCard => 'vcf', 553); 554 555# descriptions for file types not found in above file extension lookup 556my %fileDescription = ( 557 DICOM => 'Digital Imaging and Communications in Medicine', 558 XML => 'Extensible Markup Language', 559 'Win32 EXE' => 'Windows 32-bit Executable', 560 'Win32 DLL' => 'Windows 32-bit Dynamic Link Library', 561 'Win64 EXE' => 'Windows 64-bit Executable', 562 'Win64 DLL' => 'Windows 64-bit Dynamic Link Library', 563); 564 565# MIME types for applicable file types above 566# (missing entries default to 'application/unknown', but note that other MIME 567# types may be specified by some modules, eg. QuickTime.pm and RIFF.pm) 568%mimeType = ( 569 '3FR' => 'image/x-hasselblad-3fr', 570 AA => 'audio/audible', 571 AAE => 'application/vnd.apple.photos', 572 AI => 'application/vnd.adobe.illustrator', 573 AIFF => 'audio/x-aiff', 574 ALIAS=> 'application/x-macos', 575 APE => 'audio/x-monkeys-audio', 576 APNG => 'image/apng', 577 ASF => 'video/x-ms-asf', 578 ARW => 'image/x-sony-arw', 579 BMP => 'image/bmp', 580 BPG => 'image/bpg', 581 BTF => 'image/x-tiff-big', #(NC) (ref http://www.asmail.be/msg0055371937.html) 582 BZ2 => 'application/bzip2', 583 'Canon 1D RAW' => 'image/x-raw', # (uses .TIF file extension) 584 CHM => 'application/x-chm', 585 COS => 'application/octet-stream', #PH (NC) 586 CR2 => 'image/x-canon-cr2', 587 CR3 => 'image/x-canon-cr3', 588 CRM => 'video/x-canon-crm', 589 CRW => 'image/x-canon-crw', 590 CSV => 'text/csv', 591 CZI => 'image/x-zeiss-czi', #PH (NC) 592 DCP => 'application/octet-stream', #PH (NC) 593 DCR => 'image/x-kodak-dcr', 594 DCX => 'image/dcx', 595 DEX => 'application/octet-stream', 596 DFONT=> 'application/x-dfont', 597 DICOM=> 'application/dicom', 598 DIVX => 'video/divx', 599 DJVU => 'image/vnd.djvu', 600 DNG => 'image/x-adobe-dng', 601 DOC => 'application/msword', 602 DOCM => 'application/vnd.ms-word.document.macroEnabled', 603 DOCX => 'application/vnd.openxmlformats-officedocument.wordprocessingml.document', 604 DOT => 'application/msword', 605 DOTM => 'application/vnd.ms-word.template.macroEnabledTemplate', 606 DOTX => 'application/vnd.openxmlformats-officedocument.wordprocessingml.template', 607 DPX => 'image/x-dpx', 608 DR4 => 'application/octet-stream', #PH (NC) 609 DS2 => 'audio/x-ds2', 610 DSS => 'audio/x-dss', 611 DV => 'video/x-dv', 612 'DVR-MS' => 'video/x-ms-dvr', 613 DWF => 'model/vnd.dwf', 614 DWG => 'image/vnd.dwg', 615 EIP => 'application/x-captureone', #(NC) 616 EPS => 'application/postscript', 617 ERF => 'image/x-epson-erf', 618 EXE => 'application/octet-stream', 619 EXR => 'image/x-exr', 620 EXV => 'image/x-exv', 621 FFF => 'image/x-hasselblad-fff', 622 FITS => 'image/fits', 623 FLA => 'application/vnd.adobe.fla', 624 FLAC => 'audio/flac', 625 FLIF => 'image/flif', 626 FLIR => 'image/x-flir-fff', #PH (NC) 627 FLV => 'video/x-flv', 628 Font => 'application/x-font-type1', # covers PFA, PFB and PFM (not sure about PFM) 629 FPF => 'image/x-flir-fpf', #PH (NC) 630 FPX => 'image/vnd.fpx', 631 GIF => 'image/gif', 632 GPR => 'image/x-gopro-gpr', 633 GZIP => 'application/x-gzip', 634 HDP => 'image/vnd.ms-photo', 635 HDR => 'image/vnd.radiance', 636 HTML => 'text/html', 637 ICC => 'application/vnd.iccprofile', 638 ICS => 'text/calendar', 639 IDML => 'application/vnd.adobe.indesign-idml-package', 640 IIQ => 'image/x-raw', 641 IND => 'application/x-indesign', 642 INX => 'application/x-indesign-interchange', #PH (NC) 643 ISO => 'application/x-iso9660-image', 644 ITC => 'application/itunes', 645 J2C => 'image/x-j2c', #PH (NC) 646 JNG => 'image/jng', 647 JP2 => 'image/jp2', 648 JPEG => 'image/jpeg', 649 JPM => 'image/jpm', 650 JPX => 'image/jpx', 651 JSON => 'application/json', 652 JXR => 'image/jxr', 653 K25 => 'image/x-kodak-k25', 654 KDC => 'image/x-kodak-kdc', 655 KEY => 'application/x-iwork-keynote-sffkey', 656 LFP => 'image/x-lytro-lfp', #PH (NC) 657 LNK => 'application/octet-stream', 658 LRI => 'image/x-light-lri', 659 M2T => 'video/mpeg', 660 M2TS => 'video/m2ts', 661 MAX => 'application/x-3ds', 662 MEF => 'image/x-mamiya-mef', 663 MIE => 'application/x-mie', 664 MIFF => 'application/x-magick-image', 665 MKA => 'audio/x-matroska', 666 MKS => 'application/x-matroska', 667 MKV => 'video/x-matroska', 668 MNG => 'video/mng', 669 MOBI => 'application/x-mobipocket-ebook', 670 MOI => 'application/octet-stream', #PH (NC) 671 MOS => 'image/x-raw', 672 MOV => 'video/quicktime', 673 MP3 => 'audio/mpeg', 674 MP4 => 'video/mp4', 675 MPC => 'audio/x-musepack', 676 MPEG => 'video/mpeg', 677 MRW => 'image/x-minolta-mrw', 678 MXF => 'application/mxf', 679 NEF => 'image/x-nikon-nef', 680 NRW => 'image/x-nikon-nrw', 681 NUMBERS => 'application/x-iwork-numbers-sffnumbers', 682 ODB => 'application/vnd.oasis.opendocument.database', 683 ODC => 'application/vnd.oasis.opendocument.chart', 684 ODF => 'application/vnd.oasis.opendocument.formula', 685 ODG => 'application/vnd.oasis.opendocument.graphics', 686 ODI => 'application/vnd.oasis.opendocument.image', 687 ODP => 'application/vnd.oasis.opendocument.presentation', 688 ODS => 'application/vnd.oasis.opendocument.spreadsheet', 689 ODT => 'application/vnd.oasis.opendocument.text', 690 OGG => 'audio/ogg', 691 OGV => 'video/ogg', 692 ONP => 'application/on1', 693 ORF => 'image/x-olympus-orf', 694 OTF => 'application/x-font-otf', 695 PAGES=> 'application/x-iwork-pages-sffpages', 696 PBM => 'image/x-portable-bitmap', 697 PCD => 'image/x-photo-cd', 698 PCX => 'image/pcx', 699 PDB => 'application/vnd.palm', 700 PDF => 'application/pdf', 701 PEF => 'image/x-pentax-pef', 702 PFA => 'application/x-font-type1', # (needed if handled by PostScript module) 703 PGF => 'image/pgf', 704 PGM => 'image/x-portable-graymap', 705 PHP => 'application/x-httpd-php', 706 PICT => 'image/pict', 707 PLIST=> 'application/xml', # (binary PLIST format is 'application/x-plist', recognized at run time) 708 PMP => 'image/x-sony-pmp', #PH (NC) 709 PNG => 'image/png', 710 POT => 'application/vnd.ms-powerpoint', 711 POTM => 'application/vnd.ms-powerpoint.template.macroEnabled', 712 POTX => 'application/vnd.openxmlformats-officedocument.presentationml.template', 713 PPAM => 'application/vnd.ms-powerpoint.addin.macroEnabled', 714 PPAX => 'application/vnd.openxmlformats-officedocument.presentationml.addin', # (NC, PH invented) 715 PPM => 'image/x-portable-pixmap', 716 PPS => 'application/vnd.ms-powerpoint', 717 PPSM => 'application/vnd.ms-powerpoint.slideshow.macroEnabled', 718 PPSX => 'application/vnd.openxmlformats-officedocument.presentationml.slideshow', 719 PPT => 'application/vnd.ms-powerpoint', 720 PPTM => 'application/vnd.ms-powerpoint.presentation.macroEnabled', 721 PPTX => 'application/vnd.openxmlformats-officedocument.presentationml.presentation', 722 PS => 'application/postscript', 723 PSD => 'application/vnd.adobe.photoshop', 724 PSP => 'image/x-paintshoppro', #(NC) 725 QTIF => 'image/x-quicktime', 726 R3D => 'video/x-red-r3d', #PH (invented) 727 RA => 'audio/x-pn-realaudio', 728 RAF => 'image/x-fujifilm-raf', 729 RAM => 'audio/x-pn-realaudio', 730 RAR => 'application/x-rar-compressed', 731 RAW => 'image/x-raw', 732 RM => 'application/vnd.rn-realmedia', 733 RMVB => 'application/vnd.rn-realmedia-vbr', 734 RPM => 'audio/x-pn-realaudio-plugin', 735 RSRC => 'application/ResEdit', 736 RTF => 'text/rtf', 737 RV => 'video/vnd.rn-realvideo', 738 RW2 => 'image/x-panasonic-rw2', 739 RWL => 'image/x-leica-rwl', 740 RWZ => 'image/x-rawzor', #(duplicated in Rawzor.pm) 741 SEQ => 'image/x-flir-seq', #PH (NC) 742 SKETCH => 'application/sketch', 743 SR2 => 'image/x-sony-sr2', 744 SRF => 'image/x-sony-srf', 745 SRW => 'image/x-samsung-srw', 746 SVG => 'image/svg+xml', 747 SWF => 'application/x-shockwave-flash', 748 TAR => 'application/x-tar', 749 THMX => 'application/vnd.ms-officetheme', 750 TIFF => 'image/tiff', 751 Torrent => 'application/x-bittorrent', 752 TTC => 'application/x-font-ttf', 753 TTF => 'application/x-font-ttf', 754 TXT => 'text/plain', 755 VCard=> 'text/vcard', 756 VRD => 'application/octet-stream', #PH (NC) 757 VSD => 'application/x-visio', 758 WDP => 'image/vnd.ms-photo', 759 WEBM => 'video/webm', 760 WMA => 'audio/x-ms-wma', 761 WMF => 'application/x-wmf', 762 WMV => 'video/x-ms-wmv', 763 WTV => 'video/x-ms-wtv', 764 X3F => 'image/x-sigma-x3f', 765 XCF => 'image/x-xcf', 766 XLA => 'application/vnd.ms-excel', 767 XLAM => 'application/vnd.ms-excel.addin.macroEnabled', 768 XLS => 'application/vnd.ms-excel', 769 XLSB => 'application/vnd.ms-excel.sheet.binary.macroEnabled', 770 XLSM => 'application/vnd.ms-excel.sheet.macroEnabled', 771 XLSX => 'application/vnd.openxmlformats-officedocument.spreadsheetml.sheet', 772 XLT => 'application/vnd.ms-excel', 773 XLTM => 'application/vnd.ms-excel.template.macroEnabled', 774 XLTX => 'application/vnd.openxmlformats-officedocument.spreadsheetml.template', 775 XML => 'application/xml', 776 XMP => 'application/rdf+xml', 777 ZIP => 'application/zip', 778); 779 780# module names for processing routines of each file type 781# - undefined entries default to same module name as file type 782# - module name '' defaults to Image::ExifTool 783# - module name '0' indicates a recognized but unsupported file 784my %moduleName = ( 785 AA => 'Audible', 786 ALIAS=> 0, 787 AVC => 0, 788 BTF => 'BigTIFF', 789 BZ2 => 0, 790 CRW => 'CanonRaw', 791 CHM => 'EXE', 792 COS => 'CaptureOne', 793 CZI => 'ZISRAW', 794 DEX => 0, 795 DOCX => 'OOXML', 796 DCX => 0, 797 DR4 => 'CanonVRD', 798 DSS => 'Olympus', 799 DWF => 0, 800 DWG => 0, 801 EPS => 'PostScript', 802 EXIF => '', 803 EXR => 'OpenEXR', 804 EXV => '', 805 ICC => 'ICC_Profile', 806 IND => 'InDesign', 807 FLV => 'Flash', 808 FPF => 'FLIR', 809 FPX => 'FlashPix', 810 GZIP => 'ZIP', 811 HDR => 'Radiance', 812 JP2 => 'Jpeg2000', 813 JPEG => '', 814 LFP => 'Lytro', 815 LRI => 0, 816 MOV => 'QuickTime', 817 MKV => 'Matroska', 818 MP3 => 'ID3', 819 MRW => 'MinoltaRaw', 820 OGG => 'Ogg', 821 ORF => 'Olympus', 822 PDB => 'Palm', 823 PCD => 'PhotoCD', 824 PHP => 0, 825 PMP => 'Sony', 826 PS => 'PostScript', 827 PSD => 'Photoshop', 828 QTIF => 'QuickTime', 829 R3D => 'Red', 830 RAF => 'FujiFilm', 831 RAR => 'ZIP', 832 RAW => 'KyoceraRaw', 833 RWZ => 'Rawzor', 834 SWF => 'Flash', 835 TAR => 0, 836 TIFF => '', 837 TXT => 'Text', 838 VRD => 'CanonVRD', 839 WMF => 0, 840 X3F => 'SigmaRaw', 841 XCF => 'GIMP', 842); 843 844$testLen = 1024; # number of bytes to read when testing for magic number 845 846# quick "magic number" file test used to avoid loading module unnecessarily: 847# - regular expression evaluated on first $testLen bytes of file 848# - must match beginning at first byte in file 849# - this test must not be more stringent than module logic 850%magicNumber = ( 851 AA => '.{4}\x57\x90\x75\x36', 852 AIFF => '(FORM....AIF[FC]|AT&TFORM)', 853 ALIAS=> "book\0\0\0\0mark\0\0\0\0", 854 APE => '(MAC |APETAGEX|ID3)', 855 ASF => '\x30\x26\xb2\x75\x8e\x66\xcf\x11\xa6\xd9\x00\xaa\x00\x62\xce\x6c', 856 AVC => '\+A\+V\+C\+', 857 Torrent => 'd\d+:\w+', 858 BMP => 'BM', 859 BPG => "BPG\xfb", 860 BTF => '(II\x2b\0|MM\0\x2b)', 861 BZ2 => 'BZh[1-9]\x31\x41\x59\x26\x53\x59', 862 CHM => 'ITSF.{20}\x10\xfd\x01\x7c\xaa\x7b\xd0\x11\x9e\x0c\0\xa0\xc9\x22\xe6\xec', 863 CRW => '(II|MM).{4}HEAP(CCDR|JPGM)', 864 CZI => 'ZISRAWFILE\0{6}', 865 DCX => '\xb1\x68\xde\x3a', 866 DEX => "dex\n035\0", 867 DICOM=> '(.{128}DICM|\0[\x02\x04\x06\x08]\0[\0-\x20]|[\x02\x04\x06\x08]\0[\0-\x20]\0)', 868 DOCX => 'PK\x03\x04', 869 DPX => '(SDPX|XPDS)', 870 DR4 => 'IIII\x04\0\x04\0', 871 DSS => '(\x02dss|\x03ds2)', 872 DV => '\x1f\x07\0[\x3f\xbf]', # (not tested if extension recognized) 873 DWF => '\(DWF V\d', 874 DWG => 'AC10\d{2}\0', 875 EPS => '(%!PS|%!Ad|\xc5\xd0\xd3\xc6)', 876 EXE => '(MZ|\xca\xfe\xba\xbe|\xfe\xed\xfa[\xce\xcf]|[\xce\xcf]\xfa\xed\xfe|Joy!peff|\x7fELF|#!\s*/\S*bin/|!<arch>\x0a)', 877 EXIF => '(II\x2a\0|MM\0\x2a)', 878 EXR => '\x76\x2f\x31\x01', 879 EXV => '\xff\x01Exiv2', 880 FITS => 'SIMPLE = {20}T', 881 FLAC => '(fLaC|ID3)', 882 FLIF => 'FLIF[0-\x6f][0-2]', 883 FLIR => '[AF]FF\0', 884 FLV => 'FLV\x01', 885 Font => '((\0\x01\0\0|OTTO|true|typ1)[\0\x01]|ttcf\0[\x01\x02]\0\0|\0[\x01\x02]|' . 886 '(.{6})?%!(PS-(AdobeFont-|Bitstream )|FontType1-)|Start(Comp|Master)?FontMetrics|wOF[F2])', 887 FPF => 'FPF Public Image Format\0', 888 FPX => '\xd0\xcf\x11\xe0\xa1\xb1\x1a\xe1', 889 GIF => 'GIF8[79]a', 890 GZIP => '\x1f\x8b\x08', 891 HDR => '#\?(RADIANCE|RGBE)\x0a', 892 HTML => '(\xef\xbb\xbf)?\s*(?i)<(!DOCTYPE\s+HTML|HTML|\?xml)', # (case insensitive) 893 ICC => '.{12}(scnr|mntr|prtr|link|spac|abst|nmcl|nkpf)(XYZ |Lab |Luv |YCbr|Yxy |RGB |GRAY|HSV |HLS |CMYK|CMY |[2-9A-F]CLR){2}', 894 IND => '\x06\x06\xed\xf5\xd8\x1d\x46\xe5\xbd\x31\xef\xe7\xfe\x74\xb7\x1d', 895 # ISO => signature is at byte 32768 896 ITC => '.{4}itch', 897 JP2 => '(\0\0\0\x0cjP( |\x1a\x1a)\x0d\x0a\x87\x0a|\xff\x4f\xff\x51\0)', 898 JPEG => '\xff\xd8\xff', 899 JSON => '(\xef\xbb\xbf)?\s*(\[\s*)?\{\s*"[^"]*"\s*:', 900 LFP => '\x89LFP\x0d\x0a\x1a\x0a', 901 LNK => '.{4}\x01\x14\x02\0{5}\xc0\0{6}\x46', 902 LRI => 'LELR \0', 903 M2TS => '(....)?\x47', 904 MIE => '~[\x10\x18]\x04.0MIE', 905 MIFF => 'id=ImageMagick', 906 MKV => '\x1a\x45\xdf\xa3', 907 MOV => '.{4}(free|skip|wide|ftyp|pnot|PICT|pict|moov|mdat|junk|uuid)', # (duplicated in WriteQuickTime.pl !!) 908 # MP3 => difficult to rule out 909 MPC => '(MP\+|ID3)', 910 MOI => 'V6', 911 MPEG => '\0\0\x01[\xb0-\xbf]', 912 MRW => '\0MR[MI]', 913 MXF => '\x06\x0e\x2b\x34\x02\x05\x01\x01\x0d\x01\x02', # (not tested if extension recognized) 914 OGG => '(OggS|ID3)', 915 ORF => '(II|MM)', 916 PDB => '.{60}(\.pdfADBE|TEXtREAd|BVokBDIC|DB99DBOS|PNRdPPrs|DataPPrs|vIMGView|PmDBPmDB|InfoINDB|ToGoToGo|SDocSilX|JbDbJBas|JfDbJFil|DATALSdb|Mdb1Mdb1|BOOKMOBI|DataPlkr|DataSprd|SM01SMem|TEXtTlDc|InfoTlIf|DataTlMl|DataTlPt|dataTDBP|TdatTide|ToRaTRPW|zTXTGPlm|BDOCWrdS)', 917 # PCD => signature is at byte 2048 918 PCX => '\x0a[\0-\x05]\x01[\x01\x02\x04\x08].{64}[\0-\x02]', 919 PDF => '\s*%PDF-\d+\.\d+', 920 PGF => 'PGF', 921 PHP => '<\?php\s', 922 PICT => '(.{10}|.{522})(\x11\x01|\x00\x11)', 923 PLIST=> '(bplist0|\s*<|\xfe\xff\x00)', 924 PMP => '.{8}\0{3}\x7c.{112}\xff\xd8\xff\xdb', 925 PNG => '(\x89P|\x8aM|\x8bJ)NG\r\n\x1a\n', 926 PPM => 'P[1-6]\s+', 927 PS => '(%!PS|%!Ad|\xc5\xd0\xd3\xc6)', 928 PSD => '8BPS\0[\x01\x02]', 929 PSP => 'Paint Shop Pro Image File\x0a\x1a\0{5}', 930 QTIF => '.{4}(idsc|idat|iicc)', 931 R3D => '\0\0..RED(1|2)', 932 RAF => 'FUJIFILM', 933 RAR => 'Rar!\x1a\x07\0', 934 RAW => '(.{25}ARECOYK|II|MM)', 935 Real => '(\.RMF|\.ra\xfd|pnm://|rtsp://|http://)', 936 RIFF => '(RIFF|LA0[234]|OFR |LPAC|wvpk|RF64)', # RIFF plus other variants 937 RSRC => '(....)?\0\0\x01\0', 938 RTF => '[\n\r]*\\{[\n\r]*\\\\rtf', 939 RWZ => 'rawzor', 940 SWF => '[FC]WS[^\0]', 941 TAR => '.{257}ustar( )?\0', # (this doesn't catch old-style tar files) 942 TXT => '(\xff\xfe|(\0\0)?\xfe\xff|(\xef\xbb\xbf)?[\x07-\x0d\x20-\x7e\x80-\xfe]*$)', 943 TIFF => '(II|MM)', # don't test magic number (some raw formats are different) 944 VCard=> '(?i)BEGIN:(VCARD|VCALENDAR)\r\n', 945 VRD => 'CANON OPTIONAL DATA\0', 946 WMF => '(\xd7\xcd\xc6\x9a\0\0|\x01\0\x09\0\0\x03)', 947 WTV => '\xb7\xd8\x00\x20\x37\x49\xda\x11\xa6\x4e\x00\x07\xe9\x5e\xad\x8d', 948 X3F => 'FOVb', 949 MacOS=> '\0\x05\x16\x07\0.\0\0Mac OS X ', 950 XCF => 'gimp xcf ', 951 XMP => '\0{0,3}(\xfe\xff|\xff\xfe|\xef\xbb\xbf)?\0{0,3}\s*<', 952 ZIP => 'PK\x03\x04', 953); 954 955# file types with weak magic number recognition 956my %weakMagic = ( MP3 => 1 ); 957 958# file types that are determined by the process proc when FastScan == 3 959# (when done, the process proc must exit after SetFileType if FastScan is 3) 960my %processType = map { $_ => 1 } qw(JPEG TIFF XMP AIFF EXE Font PS Real VCard TXT); 961 962# Compact/XMPShorthand option settings 963my %compactOpt = ( 964 nopadding => 'NoPadding', noindent => 'NoIndent', nonewline => 'NoNewline', 965 shorthand => 'Shorthand', onedesc => 'OneDesc', 966 all => ['NoPadding','NoIndent','NoNewline','Shorthand','OneDesc'], 967 allspace => ['NoPadding','NoIndent','NoNewline'], allformat => ['Shorthand','OneDesc'], 968 # aliases to cover anticipated user typos 969 nonewlines => 'NoNewline', nospace => 'NoIndent', nospaces => 'NoIndent', 970 nopad => 'NoPadding', onedescr => 'OneDesc', 971 # allow numerical settings for backward compatibility 972 0 => 'None', 973 1 => 'NoPadding', 974 2 => ['NoPadding','NoIndent'], 975 3 => ['NoPadding','NoIndent','OneDesc'], 976 4 => ['NoPadding','NoIndent','OneDesc','NoNewline'], 977 5 => ['NoPadding','NoIndent','OneDesc','NoNewline','Shorthand'], 978); 979my %xmpShorthandOpt = ( 0 => 'None', 1 => 'Shorthand', 2 => ['Shorthand','OneDesc'] ); 980 981# lookup for valid character set names (keys are all lower case) 982%charsetName = ( 983 # Charset setting alias(es) 984 # ------------------------- -------------------------------------------- 985 utf8 => 'UTF8', cp65001 => 'UTF8', 'utf-8' => 'UTF8', 986 latin => 'Latin', cp1252 => 'Latin', latin1 => 'Latin', 987 latin2 => 'Latin2', cp1250 => 'Latin2', 988 cyrillic => 'Cyrillic', cp1251 => 'Cyrillic', russian => 'Cyrillic', 989 greek => 'Greek', cp1253 => 'Greek', 990 turkish => 'Turkish', cp1254 => 'Turkish', 991 hebrew => 'Hebrew', cp1255 => 'Hebrew', 992 arabic => 'Arabic', cp1256 => 'Arabic', 993 baltic => 'Baltic', cp1257 => 'Baltic', 994 vietnam => 'Vietnam', cp1258 => 'Vietnam', 995 thai => 'Thai', cp874 => 'Thai', 996 doslatinus => 'DOSLatinUS', cp437 => 'DOSLatinUS', 997 doslatin1 => 'DOSLatin1', cp850 => 'DOSLatin1', 998 doscyrillic => 'DOSCyrillic', cp866 => 'DOSCyrillic', 999 macroman => 'MacRoman', cp10000 => 'MacRoman', mac => 'MacRoman', roman => 'MacRoman', 1000 maclatin2 => 'MacLatin2', cp10029 => 'MacLatin2', 1001 maccyrillic => 'MacCyrillic', cp10007 => 'MacCyrillic', 1002 macgreek => 'MacGreek', cp10006 => 'MacGreek', 1003 macturkish => 'MacTurkish', cp10081 => 'MacTurkish', 1004 macromanian => 'MacRomanian', cp10010 => 'MacRomanian', 1005 maciceland => 'MacIceland', cp10079 => 'MacIceland', 1006 maccroatian => 'MacCroatian', cp10082 => 'MacCroatian', 1007); 1008 1009# default family 0 group priority for writing 1010# (NOTE: tags in groups not specified here will not be written unless 1011# overridden by the module or specified when writing) 1012my @defaultWriteGroups = qw( 1013 EXIF IPTC XMP MakerNotes QuickTime Photoshop ICC_Profile CanonVRD Adobe 1014); 1015 1016# group hash for ExifTool-generated tags 1017my %allGroupsExifTool = ( 0 => 'ExifTool', 1 => 'ExifTool', 2 => 'ExifTool' ); 1018 1019# special tag names (not used for tag info) 1020%specialTags = map { $_ => 1 } qw( 1021 TABLE_NAME SHORT_NAME PROCESS_PROC WRITE_PROC CHECK_PROC 1022 GROUPS FORMAT FIRST_ENTRY TAG_PREFIX PRINT_CONV 1023 WRITABLE TABLE_DESC NOTES IS_OFFSET IS_SUBDIR 1024 EXTRACT_UNKNOWN NAMESPACE PREFERRED SRC_TABLE PRIORITY 1025 AVOID WRITE_GROUP LANG_INFO VARS DATAMEMBER 1026 SET_GROUP1 PERMANENT INIT_TABLE 1027); 1028 1029# headers for various segment types 1030$exifAPP1hdr = "Exif\0\0"; 1031$xmpAPP1hdr = "http://ns.adobe.com/xap/1.0/\0"; 1032$xmpExtAPP1hdr = "http://ns.adobe.com/xmp/extension/\0"; 1033$psAPP13hdr = "Photoshop 3.0\0"; 1034$psAPP13old = 'Adobe_Photoshop2.5:'; 1035 1036sub DummyWriteProc { return 1; } 1037 1038# lookup for user lenses defined in @Image::ExifTool::UserDefined::Lenses 1039%Image::ExifTool::userLens = ( ); 1040 1041# queued plug-in tags to add to lookup 1042@Image::ExifTool::pluginTags = ( ); 1043%Image::ExifTool::pluginTags = ( ); 1044 1045my %systemTagsNotes = ( 1046 Notes => q{ 1047 extracted only if specifically requested or the L<SystemTags|../ExifTool.html#SystemTags> or L<RequestAll|../ExifTool.html#RequestAll> API 1048 option is set 1049 }, 1050); 1051 1052# tag information for preview image -- this should be used for all 1053# PreviewImage tags so they are handled properly when reading/writing 1054%Image::ExifTool::previewImageTagInfo = ( 1055 Name => 'PreviewImage', 1056 Writable => 'undef', 1057 # a value of 'none' is ok... 1058 WriteCheck => '$val eq "none" ? undef : $self->CheckImage(\$val)', 1059 DataTag => 'PreviewImage', 1060 # accept either scalar or scalar reference 1061 RawConv => '$self->ValidateImage(ref $val ? $val : \$val, $tag)', 1062 # we allow preview image to be set to '', but we don't want a zero-length value 1063 # in the IFD, so set it temporarily to 'none'. Note that the length is <= 4, 1064 # so this value will fit in the IFD so the preview fixup won't be generated. 1065 ValueConvInv => '$val eq "" and $val="none"; $val', 1066); 1067 1068# extra tags that aren't truly EXIF tags, but are generated by the script 1069# Note: any tag in this list with a name corresponding to a Group0 name is 1070# used to write the entire corresponding directory as a block. 1071%Image::ExifTool::Extra = ( 1072 GROUPS => { 0 => 'File', 1 => 'File', 2 => 'Image' }, 1073 VARS => { NO_ID => 1 }, # tag ID's aren't meaningful for these tags 1074 WRITE_PROC => \&DummyWriteProc, 1075 Error => { 1076 Priority => 0, 1077 Groups => \%allGroupsExifTool, 1078 Notes => q{ 1079 returns errors that may have occurred while reading or writing a file. Any 1080 Error will prevent the file from being processed. Minor errors may be 1081 downgraded to warnings with the -m or L<IgnoreMinorErrors|../ExifTool.html#IgnoreMinorErrors> option 1082 }, 1083 }, 1084 Warning => { 1085 Priority => 0, 1086 Groups => \%allGroupsExifTool, 1087 Notes => q{ 1088 returns warnings that may have occurred while reading or writing a file. 1089 Use the -a or L<Duplicates|../ExifTool.html#Duplicates> option to see all warnings if more than one 1090 occurred. Minor warnings may be ignored with the -m or L<IgnoreMinorErrors|../ExifTool.html#IgnoreMinorErrors> 1091 option. Minor warnings with a capital "M" in the "[Minor]" designation 1092 indicate that the processing is affected by ignoring the warning 1093 }, 1094 }, 1095 Comment => { 1096 Notes => 'comment embedded in JPEG, GIF89a or PPM/PGM/PBM image', 1097 Writable => 1, 1098 WriteGroup => 'Comment', 1099 Priority => 0, # to preserve order of JPEG COM segments 1100 }, 1101 Directory => { 1102 Groups => { 1 => 'System', 2 => 'Other' }, 1103 Notes => q{ 1104 the directory of the file as specified in the call to ExifTool, or "." if no 1105 directory was specified. May be written to move the file to another 1106 directory that will be created if doesn't already exist 1107 }, 1108 Writable => 1, 1109 WritePseudo => 1, 1110 DelCheck => q{"Can't delete"}, 1111 Protected => 1, 1112 RawConv => '$self->ConvertFileName($val)', 1113 # translate backslashes in directory names and add trailing '/' 1114 ValueConvInv => '$_ = $self->InverseFileName($val); m{[^/]$} and $_ .= "/"; $_', 1115 }, 1116 FileName => { 1117 Groups => { 1 => 'System', 2 => 'Other' }, 1118 Writable => 1, 1119 WritePseudo => 1, 1120 DelCheck => q{"Can't delete"}, 1121 Protected => 1, 1122 Notes => q{ 1123 may be written with a full path name to set FileName and Directory in one 1124 operation. This is such a powerful feature that a TestName tag is provided 1125 to allow dry-run tests before actually writing the file name. See 1126 L<filename.html|../filename.html> for more information on writing the 1127 FileName, Directory and TestName tags 1128 }, 1129 RawConv => '$self->ConvertFileName($val)', 1130 ValueConvInv => '$self->InverseFileName($val)', 1131 }, 1132 FilePath => { 1133 Groups => { 1 => 'System', 2 => 'Other' }, 1134 Notes => q{ 1135 absolute path of source file. Not generated unless specifically requested or 1136 the L<RequestAll|../ExifTool.html#RequestAll> API option is set. Does not support Windows Unicode file 1137 names 1138 }, 1139 }, 1140 TestName => { 1141 Writable => 1, 1142 WritePseudo => 1, 1143 DelCheck => q{"Can't delete"}, 1144 Protected => 1, 1145 WriteOnly => 1, 1146 Notes => q{ 1147 this write-only tag may be used instead of FileName for dry-run tests of the 1148 file renaming feature. Writing this tag prints the old and new file names 1149 to the console, but does not affect the file itself 1150 }, 1151 ValueConvInv => '$self->InverseFileName($val)', 1152 }, 1153 FileSequence => { 1154 Groups => { 0 => 'ExifTool', 1 => 'ExifTool', 2 => 'Other' }, 1155 Notes => q{ 1156 sequence number for each source file when extracting or copying information, 1157 including files that fail the -if condition of the command-line application, 1158 beginning at 0 for the first file. Not generated unless specifically 1159 requested or the L<RequestAll|../ExifTool.html#RequestAll> API option is set 1160 }, 1161 }, 1162 FileSize => { 1163 Groups => { 1 => 'System', 2 => 'Other' }, 1164 Notes => q{ 1165 note that the print conversion for this tag uses historic prefixes: 1 kB = 1166 1024 bytes, etc. 1167 }, 1168 PrintConv => \&ConvertFileSize, 1169 }, 1170 ResourceForkSize => { 1171 Groups => { 1 => 'System', 2 => 'Other' }, 1172 Notes => q{ 1173 size of the file's resource fork if it contains data. Mac OS only. If this 1174 tag is generated the L<ExtractEmbedded|../ExifTool.html#ExtractEmbedded> option may be used to extract 1175 resource-fork information as a sub-document. When writing, the resource 1176 fork is preserved by default, but it may be deleted with C<-rsrc:all=> on 1177 the command line 1178 }, 1179 PrintConv => \&ConvertFileSize, 1180 }, 1181 FileType => { 1182 Groups => { 2 => 'Other' }, 1183 Notes => q{ 1184 a short description of the file type. For many file types this is the just 1185 the uppercase file extension 1186 }, 1187 }, 1188 FileTypeExtension => { 1189 Groups => { 2 => 'Other' }, 1190 Notes => q{ 1191 a common lowercase extension for this file type, or uppercase with the -n 1192 option 1193 }, 1194 PrintConv => 'lc $val', 1195 }, 1196 FileModifyDate => { 1197 Description => 'File Modification Date/Time', 1198 Notes => q{ 1199 the filesystem modification date/time. Note that ExifTool may not be able 1200 to handle filesystem dates before 1970 depending on the limitations of the 1201 system's standard libraries 1202 }, 1203 Groups => { 1 => 'System', 2 => 'Time' }, 1204 Writable => 1, 1205 WritePseudo => 1, 1206 DelCheck => q{"Can't delete"}, 1207 # all writable pseudo-tags must be protected so -tagsfromfile fails with 1208 # unrecognized files unless a pseudo tag is specified explicitly 1209 Protected => 1, 1210 Shift => 'Time', 1211 ValueConv => 'ConvertUnixTime($val,1)', 1212 ValueConvInv => 'GetUnixTime($val,1)', 1213 PrintConv => '$self->ConvertDateTime($val)', 1214 PrintConvInv => '$self->InverseDateTime($val)', 1215 }, 1216 FileAccessDate => { 1217 Description => 'File Access Date/Time', 1218 Notes => q{ 1219 the date/time of last access of the file. Note that this access time is 1220 updated whenever any software, including ExifTool, reads the file 1221 }, 1222 Groups => { 1 => 'System', 2 => 'Time' }, 1223 ValueConv => 'ConvertUnixTime($val,1)', 1224 PrintConv => '$self->ConvertDateTime($val)', 1225 }, 1226 FileCreateDate => { 1227 Description => 'File Creation Date/Time', 1228 Notes => q{ 1229 the filesystem creation date/time. Windows/Mac only. In Windows, the file 1230 creation date/time is preserved by default when writing if Win32API::File 1231 and Win32::API are available. On Mac, this tag is extracted only if it or 1232 the MacOS group is specifically requested or the L<RequestAll|../ExifTool.html#RequestAll> API option is 1233 set to 2 or higher. Requires "setfile" for writing on Mac, which may be 1234 installed by typing C<xcode-select --install> in the Terminal 1235 }, 1236 Groups => { 1 => 'System', 2 => 'Time' }, 1237 Writable => 1, 1238 WritePseudo => 1, 1239 DelCheck => q{"Can't delete"}, 1240 Protected => 1, # all writable pseudo-tags must be protected! 1241 Shift => 'Time', 1242 ValueConv => '$^O eq "darwin" ? $val : ConvertUnixTime($val,1)', 1243 ValueConvInv => q{ 1244 return GetUnixTime($val,1) if $^O eq 'MSWin32'; 1245 return $val if $^O eq 'darwin'; 1246 warn "This tag is Windows/Mac only\n"; 1247 return undef; 1248 }, 1249 PrintConv => '$self->ConvertDateTime($val)', 1250 PrintConvInv => '$self->InverseDateTime($val)', 1251 }, 1252 FileInodeChangeDate => { 1253 Description => 'File Inode Change Date/Time', 1254 Notes => q{ 1255 the date/time when the file's directory information was last changed. 1256 Non-Windows systems only 1257 }, 1258 Groups => { 1 => 'System', 2 => 'Time' }, 1259 ValueConv => 'ConvertUnixTime($val,1)', 1260 PrintConv => '$self->ConvertDateTime($val)', 1261 }, 1262 FilePermissions => { 1263 Groups => { 1 => 'System', 2 => 'Other' }, 1264 Notes => q{ 1265 r=read, w=write and x=execute permissions for the file owner, group and 1266 others. The ValueConv value is an octal number so bit test operations on 1267 this value should be done in octal, eg. 'oct($filePermissions#) & 0200' 1268 }, 1269 Writable => 1, 1270 WritePseudo => 1, 1271 DelCheck => q{"Can't delete"}, 1272 Protected => 1, # all writable pseudo-tags must be protected! 1273 ValueConv => 'sprintf("%.3o", $val & 0777)', 1274 ValueConvInv => 'oct($val)', 1275 PrintConv => sub { 1276 my ($mask, $str, $val) = (0400, '', oct(shift)); 1277 while ($mask) { 1278 foreach (qw(r w x)) { 1279 $str .= $val & $mask ? $_ : '-'; 1280 $mask >>= 1; 1281 } 1282 } 1283 return $str; 1284 }, 1285 PrintConvInv => sub { 1286 my ($bit, $val, $str) = (8, 0, shift); 1287 return undef if length($str) != 9; 1288 while ($bit >= 0) { 1289 foreach (qw(r w x)) { 1290 $val |= (1 << $bit) if substr($str, 8-$bit, 1) eq $_; 1291 --$bit; 1292 } 1293 } 1294 return sprintf('%.3o', $val); 1295 }, 1296 }, 1297 FileAttributes => { 1298 Groups => { 1 => 'System', 2 => 'Other' }, 1299 Notes => q{ 1300 extracted only if specifically requested or the L<SystemTags|../ExifTool.html#SystemTags> or L<RequestAll|../ExifTool.html#RequestAll> API 1301 option is set. 2 or 3 values: 0. File type, 1. Attribute bits, 2. Windows 1302 attribute bits if Win32API::File is available 1303 }, 1304 PrintHex => 1, 1305 PrintConvColumns => 2, 1306 PrintConv => [{ # stat device types (bitmask 0xf000) 1307 0x0000 => 'Unknown', 1308 0x1000 => 'FIFO', 1309 0x2000 => 'Character', 1310 0x3000 => 'Mux Character', 1311 0x4000 => 'Directory', 1312 0x5000 => 'XENIX Named', 1313 0x6000 => 'Block', 1314 0x7000 => 'Mux Block', 1315 0x8000 => 'Regular', 1316 0x9000 => 'VxFS Compressed', 1317 0xa000 => 'Symbolic Link', 1318 0xb000 => 'Solaris Shadow Inode', 1319 0xc000 => 'Socket', 1320 0xd000 => 'Solaris Door', 1321 0xe000 => 'BSD Whiteout', 1322 },{ BITMASK => { # stat attribute bits (bitmask 0x0e00) 1323 9 => 'Sticky', 1324 10 => 'Set Group ID', 1325 11 => 'Set User ID', 1326 }},{ BITMASK => { # Windows attribute bits 1327 0 => 'Read Only', 1328 1 => 'Hidden', 1329 2 => 'System', 1330 3 => 'Volume Label', 1331 4 => 'Directory', 1332 5 => 'Archive', 1333 6 => 'Device', 1334 7 => 'Normal', 1335 8 => 'Temporary', 1336 9 => 'Sparse File', 1337 10 => 'Reparse Point', 1338 11 => 'Compressed', 1339 12 => 'Offline', 1340 13 => 'Not Content Indexed', 1341 14 => 'Encrypted', 1342 }}], 1343 }, 1344 FileDeviceID => { 1345 Groups => { 1 => 'System', 2 => 'Other' }, 1346 %systemTagsNotes, 1347 PrintConv => '(($val >> 24) & 0xff) . "." . ($val & 0xffffff)', # (major.minor) 1348 }, 1349 FileDeviceNumber => { Groups => { 1 => 'System', 2 => 'Other' }, %systemTagsNotes }, 1350 FileInodeNumber => { Groups => { 1 => 'System', 2 => 'Other' }, %systemTagsNotes }, 1351 FileHardLinks => { Groups => { 1 => 'System', 2 => 'Other' }, %systemTagsNotes }, 1352 FileUserID => { 1353 Groups => { 1 => 'System', 2 => 'Other' }, 1354 Notes => q{ 1355 extracted only if specifically requested or the L<SystemTags|../ExifTool.html#SystemTags> or L<RequestAll|../ExifTool.html#RequestAll> API 1356 option is set. Returns user ID number with the -n option, or name 1357 otherwise. May be written with either user name or number 1358 }, 1359 Writable => 1, 1360 WritePseudo => 1, 1361 DelCheck => q{"Can't delete"}, 1362 Protected => 1, # all writable pseudo-tags must be protected! 1363 PrintConv => 'eval { getpwuid($val) } || $val', 1364 PrintConvInv => 'eval { getpwnam($val) } || ($val=~/[^0-9]/ ? undef : $val)', 1365 }, 1366 FileGroupID => { 1367 Groups => { 1 => 'System', 2 => 'Other' }, 1368 Notes => q{ 1369 extracted only if specifically requested or the L<SystemTags|../ExifTool.html#SystemTags> or L<RequestAll|../ExifTool.html#RequestAll> API 1370 option is set. Returns group ID number with the -n option, or name 1371 otherwise. May be written with either group name or number 1372 }, 1373 Writable => 1, 1374 WritePseudo => 1, 1375 DelCheck => q{"Can't delete"}, 1376 Protected => 1, # all writable pseudo-tags must be protected! 1377 PrintConv => 'eval { getgrgid($val) } || $val', 1378 PrintConvInv => 'eval { getgrnam($val) } || ($val=~/[^0-9]/ ? undef : $val)', 1379 }, 1380 FileBlockSize => { Groups => { 1 => 'System', 2 => 'Other' }, %systemTagsNotes }, 1381 FileBlockCount => { Groups => { 1 => 'System', 2 => 'Other' }, %systemTagsNotes }, 1382 HardLink => { 1383 Writable => 1, 1384 DelCheck => q{"Can't delete"}, 1385 WriteOnly => 1, 1386 WritePseudo => 1, 1387 Protected => 1, 1388 Notes => q{ 1389 this write-only tag is used to create a hard link with the specified name to 1390 the source file. If the source file is edited, copied, renamed or moved in 1391 the same operation as writing HardLink, then the link is made to the updated 1392 file. Note that subsequent editing of either hard-linked file by exiftool 1393 will break the link unless the -overwrite_original_in_place option is used 1394 }, 1395 ValueConvInv => '$val=~tr/\\\\/\//; $val', 1396 }, 1397 SymLink => { 1398 Writable => 1, 1399 DelCheck => q{"Can't delete"}, 1400 WriteOnly => 1, 1401 WritePseudo => 1, 1402 Protected => 1, 1403 Notes => q{ 1404 this write-only tag is used to create a symbolic link with the specified 1405 name to the source file. If the source file is edited, copied, renamed or 1406 moved in the same operation as writing SymLink, then the link is made to the 1407 updated file. The link uses an absolute path unless it is created in the 1408 current working directory. Valid only for file systems that support 1409 symbolic links. Note that subsequent editing of the file via the symbolic 1410 link by exiftool will cause the link to be replaced by the edited file 1411 without changing the original unless the -overwrite_original_in_place option 1412 is used 1413 }, 1414 ValueConvInv => '$val=~tr/\\\\/\//; $val', 1415 }, 1416 MIMEType => { Notes => 'the MIME type of the source file', Groups => { 2 => 'Other' } }, 1417 ImageWidth => { Notes => 'the width of the image in number of pixels' }, 1418 ImageHeight => { Notes => 'the height of the image in number of pixels' }, 1419 XResolution => { Notes => 'the horizontal pixel resolution' }, 1420 YResolution => { Notes => 'the vertical pixel resolution' }, 1421 MaxVal => { Notes => 'maximum pixel value in PPM or PGM image' }, 1422 EXIF => { 1423 Notes => q{ 1424 the full EXIF data block from JPEG, PNG, JP2, MIE and MIFF images. This tag 1425 is generated only if specifically requested 1426 }, 1427 Groups => { 0 => 'EXIF', 1 => 'EXIF' }, 1428 Flags => ['Writable' ,'Protected', 'Binary', 'DelGroup'], 1429 WriteCheck => q{ 1430 return undef if $val =~ /^(II\x2a\0|MM\0\x2a)/; 1431 return 'Invalid EXIF data'; 1432 }, 1433 }, 1434 IPTC => { 1435 Notes => q{ 1436 the full IPTC data block. This tag is generated only if specifically 1437 requested 1438 }, 1439 Groups => { 0 => 'IPTC', 1 => 'IPTC' }, 1440 Flags => ['Writable', 'Protected', 'Binary', 'DelGroup'], 1441 Priority => 0, # so main IPTC (which hopefully comes first) takes priority 1442 WriteCheck => q{ 1443 return undef if $val =~ /^(\x1c|\0+$)/; 1444 return 'Invalid IPTC data'; 1445 }, 1446 }, 1447 XMP => { 1448 Notes => q{ 1449 the XMP data block, but note that extended XMP in JPEG images may be split 1450 into multiple blocks. This tag is generated only if specifically requested 1451 }, 1452 Groups => { 0 => 'XMP', 1 => 'XMP' }, 1453 Flags => ['Writable', 'Protected', 'Binary', 'DelGroup'], 1454 Priority => 0, # so main xmp (which usually comes first) takes priority 1455 WriteCheck => q{ 1456 require Image::ExifTool::XMP; 1457 return Image::ExifTool::XMP::CheckXMP($self, $tagInfo, \$val); 1458 }, 1459 }, 1460 XML => { 1461 Notes => 'the XML data block, extracted for some file types', 1462 Groups => { 0 => 'XML', 1 => 'XML' }, 1463 Binary => 1, 1464 }, 1465 ICC_Profile => { 1466 Notes => q{ 1467 the full ICC_Profile data block. This tag is generated only if specifically 1468 requested 1469 }, 1470 Groups => { 0 => 'ICC_Profile', 1 => 'ICC_Profile' }, 1471 Flags => ['Writable' ,'Protected', 'Binary', 'DelGroup'], 1472 WriteCheck => q{ 1473 require Image::ExifTool::ICC_Profile; 1474 return Image::ExifTool::ICC_Profile::ValidateICC(\$val); 1475 }, 1476 }, 1477 CanonVRD => { 1478 Notes => q{ 1479 the full Canon DPP VRD trailer block. This tag is generated only if 1480 specifically requested 1481 }, 1482 Groups => { 0 => 'CanonVRD', 1 => 'CanonVRD' }, 1483 Flags => ['Writable' ,'Protected', 'Binary', 'DelGroup'], 1484 Permanent => 0, # (this is 1 by default for MakerNotes tags) 1485 WriteCheck => q{ 1486 return undef if $val =~ /^CANON OPTIONAL DATA\0/; 1487 return 'Invalid CanonVRD data'; 1488 }, 1489 }, 1490 CanonDR4 => { 1491 Notes => q{ 1492 the full Canon DPP version 4 DR4 block. This tag is generated only if 1493 specifically requested 1494 }, 1495 Groups => { 0 => 'CanonVRD', 1 => 'CanonVRD' }, 1496 Flags => ['Writable' ,'Protected', 'Binary'], 1497 Permanent => 0, # (this is 1 by default for MakerNotes tags) 1498 WriteCheck => q{ 1499 return undef if $val =~ /^IIII\x04\0\x04\0/; 1500 return 'Invalid CanonDR4 data'; 1501 }, 1502 }, 1503 Adobe => { 1504 Notes => q{ 1505 the JPEG APP14 Adobe segment. Extracted only if specified. See the 1506 L<JPEG Adobe Tags|JPEG.html#Adobe> for more information 1507 }, 1508 Groups => { 0 => 'APP14', 1 => 'Adobe' }, 1509 WriteGroup => 'Adobe', 1510 Flags => ['Writable' ,'Protected', 'Binary'], 1511 }, 1512 CurrentIPTCDigest => { 1513 Notes => q{ 1514 MD5 digest of existing IPTC data. All zeros if IPTC exists but Digest::MD5 1515 is not installed. Only calculated for IPTC in the standard location as 1516 specified by the L<MWG|http://www.metadataworkinggroup.org/>. ExifTool 1517 automates the handling of this tag in the MWG module -- see the 1518 L<MWG Composite Tags|MWG.html> for details 1519 }, 1520 ValueConv => 'unpack("H*", $val)', 1521 }, 1522 PreviewImage => { 1523 Notes => 'JPEG-format embedded preview image', 1524 Groups => { 2 => 'Preview' }, 1525 Writable => 1, 1526 WriteCheck => '$self->CheckImage(\$val)', 1527 WriteGroup => 'All', 1528 # can't delete, so set to empty string and return no error 1529 DelCheck => '$val = ""; return undef', 1530 # accept either scalar or scalar reference 1531 RawConv => '$self->ValidateImage(ref $val ? $val : \$val, $tag)', 1532 }, 1533 ThumbnailImage => { 1534 Groups => { 2 => 'Preview' }, 1535 Notes => 'JPEG-format embedded thumbnail image', 1536 RawConv => '$self->ValidateImage(ref $val ? $val : \$val, $tag)', 1537 }, 1538 OtherImage => { 1539 Groups => { 2 => 'Preview' }, 1540 Notes => 'other JPEG-format embedded image', 1541 RawConv => '$self->ValidateImage(ref $val ? $val : \$val, $tag)', 1542 }, 1543 PreviewPNG => { 1544 Groups => { 2 => 'Preview' }, 1545 Notes => 'PNG-format embedded preview image', 1546 Binary => 1, 1547 }, 1548 PreviewWMF => { 1549 Groups => { 2 => 'Preview' }, 1550 Notes => 'WMF-format embedded preview image', 1551 Binary => 1, 1552 }, 1553 PreviewTIFF => { 1554 Groups => { 2 => 'Preview' }, 1555 Notes => 'TIFF-format embedded preview image', 1556 Binary => 1, 1557 }, 1558 PreviewPDF => { 1559 Groups => { 2 => 'Preview' }, 1560 Notes => 'PDF-format embedded preview image', 1561 Binary => 1, 1562 }, 1563 ExifByteOrder => { 1564 Writable => 1, 1565 DelCheck => q{"Can't delete"}, 1566 Notes => q{ 1567 represents the byte order of EXIF information. May be written to set the 1568 byte order only for newly created EXIF segments 1569 }, 1570 PrintConv => { 1571 II => 'Little-endian (Intel, II)', 1572 MM => 'Big-endian (Motorola, MM)', 1573 }, 1574 }, 1575 ExifUnicodeByteOrder => { 1576 Writable => 1, 1577 WriteOnly => 1, 1578 DelCheck => q{"Can't delete"}, 1579 Notes => q{ 1580 specifies the byte order to use when writing EXIF Unicode text. The EXIF 1581 specification is particularly vague about this byte ordering, and different 1582 applications use different conventions. By default ExifTool writes Unicode 1583 text in EXIF byte order, but this write-only tag may be used to force a 1584 specific order. Applies to the EXIF UserComment tag when writing special 1585 characters 1586 }, 1587 PrintConv => { 1588 II => 'Little-endian (Intel, II)', 1589 MM => 'Big-endian (Motorola, MM)', 1590 }, 1591 }, 1592 ExifToolVersion => { 1593 Description => 'ExifTool Version Number', 1594 Groups => \%allGroupsExifTool, 1595 Notes => 'the version of ExifTool currently running', 1596 }, 1597 ProcessingTime => { 1598 Groups => { 0 => 'ExifTool', 1 => 'ExifTool', 2 => 'Other' }, 1599 Notes => q{ 1600 the clock time in seconds taken by ExifTool to extract information from this 1601 file. Not generated unless specifically requested or the L<RequestAll|../ExifTool.html#RequestAll> API 1602 option is set. Requires Time::HiRes 1603 }, 1604 PrintConv => 'sprintf("%.3g s", $val)', 1605 }, 1606 RAFVersion => { Notes => 'RAF file version number' }, 1607 JPEGDigest => { 1608 Notes => q{ 1609 an MD5 digest of the JPEG quantization tables is combined with the component 1610 sub-sampling values to generate the value of this tag. The result is 1611 compared to known values in an attempt to deduce the originating software 1612 based only on the JPEG image data. For performance reasons, this tag is 1613 generated only if specifically requested or the L<RequestAll|../ExifTool.html#RequestAll> API option is set 1614 to 3 or higher 1615 }, 1616 }, 1617 JPEGQualityEstimate => { 1618 Notes => q{ 1619 an estimate of the IJG JPEG quality setting for the image, calculated from 1620 the quantization tables. For performance reasons, this tag is generated 1621 only if specifically requested or the L<RequestAll|../ExifTool.html#RequestAll> API option is set to 3 or 1622 higher 1623 }, 1624 }, 1625 JPEGImageLength => { 1626 Notes => q{ 1627 byte length of JPEG image without metadata. For performance reasons, this 1628 tag is generated only if specifically requested or the L<RequestAll|../ExifTool.html#RequestAll> API option 1629 is set to 3 or higher 1630 }, 1631 }, 1632 # Validate (added from Validate.pm) 1633 Now => { 1634 Groups => { 0 => 'ExifTool', 1 => 'ExifTool', 2 => 'Time' }, 1635 Notes => q{ 1636 the current date/time. Useful when setting the tag values, eg. 1637 C<"-modifydate<now">. Not generated unless specifically requested or the 1638 L<RequestAll|../ExifTool.html#RequestAll> API option is set 1639 }, 1640 PrintConv => '$self->ConvertDateTime($val)', 1641 }, 1642 NewGUID => { 1643 Groups => { 0 => 'ExifTool', 1 => 'ExifTool', 2 => 'Other' }, 1644 Notes => q{ 1645 generates a new, random GUID with format 1646 YYYYmmdd-HHMM-SSNN-PPPP-RRRRRRRRRRRR, where Y=year, m=month, d=day, H=hour, 1647 M=minute, S=second, N=file sequence number in hex, P=process ID in hex, and 1648 R=random hex number; without dashes with the -n option. Not generated 1649 unless specifically requested or the L<RequestAll|../ExifTool.html#RequestAll> API option is set 1650 }, 1651 PrintConv => '$val =~ s/(.{8})(.{4})(.{4})(.{4})/$1-$2-$3-$4-/; $val', 1652 }, 1653 ID3Size => { Notes => 'size of the ID3 data block' }, 1654 Geotag => { 1655 Writable => 1, 1656 WriteOnly => 1, 1657 WriteNothing => 1, 1658 AllowGroup => '(exif|gps|xmp|xmp-exif)', 1659 Notes => q{ 1660 this write-only tag is used to define the GPS track log data or track log 1661 file name. Currently supported track log formats are GPX, NMEA RMC/GGA/GLL, 1662 KML, IGC, Garmin XML and TCX, Magellan PMGNTRK, Honeywell PTNTHPR, Winplus 1663 Beacon text, and Bramor gEO log files. May be set to the special value of 1664 "DATETIMEONLY" (all caps) to set GPS date/time tags if no input track points 1665 are available. See L<geotag.html|../geotag.html> for details 1666 }, 1667 DelCheck => q{ 1668 require Image::ExifTool::Geotag; 1669 # delete associated tags 1670 Image::ExifTool::Geotag::SetGeoValues($self, undef, $wantGroup); 1671 }, 1672 ValueConvInv => q{ 1673 require Image::ExifTool::Geotag; 1674 # always warn because this tag is never set (warning is "\n" on success) 1675 my $result = Image::ExifTool::Geotag::LoadTrackLog($self, $val); 1676 return '' if not defined $result; # deleting geo tags 1677 return $result if ref $result; # geotag data hash reference 1678 warn "$result\n"; # error string 1679 }, 1680 }, 1681 Geotime => { 1682 Writable => 1, 1683 WriteOnly => 1, 1684 AllowGroup => '(exif|gps|xmp|xmp-exif)', 1685 Notes => q{ 1686 this write-only tag is used to define a date/time for interpolating a 1687 position in the GPS track specified by the Geotag tag. Writing this tag 1688 causes GPS information to be written into the EXIF or XMP of the target 1689 files. The local system timezone is assumed if the date/time value does not 1690 contain a timezone. May be deleted to delete associated GPS tags. A group 1691 name of "EXIF" or "XMP" may be specified to write or delete only EXIF or XMP 1692 GPS tags 1693 }, 1694 DelCheck => q{ 1695 require Image::ExifTool::Geotag; 1696 # delete associated tags 1697 Image::ExifTool::Geotag::SetGeoValues($self, undef, $wantGroup); 1698 }, 1699 ValueConvInv => q{ 1700 require Image::ExifTool::Geotag; 1701 warn Image::ExifTool::Geotag::SetGeoValues($self, $val, $wantGroup) . "\n"; 1702 return undef; 1703 }, 1704 }, 1705 Geosync => { 1706 Writable => 1, 1707 WriteOnly => 1, 1708 WriteNothing => 1, 1709 AllowGroup => '(exif|gps|xmp|xmp-exif)', 1710 Shift => 'Time', # enables "+=" syntax as well as "=+" 1711 Notes => q{ 1712 this write-only tag specifies a time difference to add to Geotime for 1713 synchronization with the GPS clock. For example, set this to "-12" if the 1714 camera clock is 12 seconds faster than GPS time. Input format is 1715 "[+-][[[DD ]HH:]MM:]SS[.ss]". Additional features allow calculation of time 1716 differences and time drifts, and extraction of synchronization times from 1717 image files. See the L<geotagging documentation|../geotag.html> for details 1718 }, 1719 ValueConvInv => q{ 1720 require Image::ExifTool::Geotag; 1721 return Image::ExifTool::Geotag::ConvertGeosync($self, $val); 1722 }, 1723 }, 1724 ForceWrite => { 1725 Groups => { 0 => '*', 1 => '*', 2 => '*' }, 1726 Writable => 1, 1727 WriteOnly => 1, 1728 Notes => q{ 1729 write-only tag used to force metadata in a file to be rewritten even if no 1730 tag values are changed. May be set to "EXIF", "IPTC", "XMP" or "PNG" to 1731 force the corresponding metadata type to be rewritten, "FixBase" to cause 1732 EXIF to be rewritten only if the MakerNotes offset base was fixed, or "All" 1733 to rewrite all of these metadata types. Values are case insensitive, and 1734 multiple values may be separated with commas, eg. C<-ForceWrite=exif,xmp> 1735 }, 1736 }, 1737 EmbeddedVideo => { Groups => { 0 => 'Trailer', 2 => 'Video' } }, 1738 Trailer => { 1739 Groups => { 0 => 'Trailer' }, 1740 Notes => 'the full JPEG trailer data block. Extracted only if specifically requested', 1741 Writable => 1, 1742 Protected => 1, 1743 }, 1744); 1745 1746# tags defined by UserParam option (added at runtime) 1747%Image::ExifTool::UserParam = ( 1748 GROUPS => { 0 => 'UserParam', 1 => 'UserParam', 2 => 'Other' }, 1749 PRIORITY => 0, 1750); 1751 1752# YCbCrSubSampling values (used by JPEG SOF, EXIF and XMP) 1753%Image::ExifTool::JPEG::yCbCrSubSampling = ( 1754 '1 1' => 'YCbCr4:4:4 (1 1)', #PH 1755 '2 1' => 'YCbCr4:2:2 (2 1)', #14 in Exif.pm 1756 '2 2' => 'YCbCr4:2:0 (2 2)', #14 in Exif.pm 1757 '4 1' => 'YCbCr4:1:1 (4 1)', #14 in Exif.pm 1758 '4 2' => 'YCbCr4:1:0 (4 2)', #PH 1759 '1 2' => 'YCbCr4:4:0 (1 2)', #PH 1760 '1 4' => 'YCbCr4:4:1 (1 4)', #JD 1761 '2 4' => 'YCbCr4:2:1 (2 4)', #JD 1762); 1763 1764# define common JPEG segments here to avoid overhead of loading JPEG module 1765 1766# JPEG SOF (start of frame) tags 1767# (ref http://www.w3.org/Graphics/JPEG/itu-t81.pdf) 1768%Image::ExifTool::JPEG::SOF = ( 1769 GROUPS => { 0 => 'File', 1 => 'File', 2 => 'Image' }, 1770 NOTES => 'This information is extracted from the JPEG Start Of Frame segment.', 1771 VARS => { NO_ID => 1 }, # tag ID's aren't meaningful for these tags 1772 EncodingProcess => { 1773 PrintHex => 1, 1774 PrintConv => { 1775 0x0 => 'Baseline DCT, Huffman coding', 1776 0x1 => 'Extended sequential DCT, Huffman coding', 1777 0x2 => 'Progressive DCT, Huffman coding', 1778 0x3 => 'Lossless, Huffman coding', 1779 0x5 => 'Sequential DCT, differential Huffman coding', 1780 0x6 => 'Progressive DCT, differential Huffman coding', 1781 0x7 => 'Lossless, Differential Huffman coding', 1782 0x9 => 'Extended sequential DCT, arithmetic coding', 1783 0xa => 'Progressive DCT, arithmetic coding', 1784 0xb => 'Lossless, arithmetic coding', 1785 0xd => 'Sequential DCT, differential arithmetic coding', 1786 0xe => 'Progressive DCT, differential arithmetic coding', 1787 0xf => 'Lossless, differential arithmetic coding', 1788 } 1789 }, 1790 BitsPerSample => { }, 1791 ImageHeight => { }, 1792 ImageWidth => { }, 1793 ColorComponents => { }, 1794 YCbCrSubSampling => { 1795 Notes => 'calculated from components table', 1796 PrintConv => \%Image::ExifTool::JPEG::yCbCrSubSampling, 1797 }, 1798); 1799 1800# JPEG JFIF APP0 definitions 1801%Image::ExifTool::JFIF::Main = ( 1802 PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData, 1803 WRITE_PROC => \&Image::ExifTool::WriteBinaryData, 1804 CHECK_PROC => \&Image::ExifTool::CheckBinaryData, 1805 GROUPS => { 0 => 'JFIF', 1 => 'JFIF', 2 => 'Image' }, 1806 DATAMEMBER => [ 2, 3, 5 ], 1807 0 => { 1808 Name => 'JFIFVersion', 1809 Format => 'int8u[2]', 1810 PrintConv => 'sprintf("%d.%.2d", split(" ",$val))', 1811 Mandatory => 1, 1812 }, 1813 2 => { 1814 Name => 'ResolutionUnit', 1815 Writable => 1, 1816 RawConv => '$$self{JFIFResolutionUnit} = $val', 1817 PrintConv => { 1818 0 => 'None', 1819 1 => 'inches', 1820 2 => 'cm', 1821 }, 1822 Priority => -1, 1823 Mandatory => 1, 1824 }, 1825 3 => { 1826 Name => 'XResolution', 1827 Format => 'int16u', 1828 Writable => 1, 1829 Priority => -1, 1830 RawConv => '$$self{JFIFXResolution} = $val', 1831 Mandatory => 1, 1832 }, 1833 5 => { 1834 Name => 'YResolution', 1835 Format => 'int16u', 1836 Writable => 1, 1837 Priority => -1, 1838 RawConv => '$$self{JFIFYResolution} = $val', 1839 Mandatory => 1, 1840 }, 1841 7 => { 1842 Name => 'ThumbnailWidth', 1843 RawConv => '$val ? $$self{JFIFThumbnailWidth} = $val : undef', 1844 }, 1845 8 => { 1846 Name => 'ThumbnailHeight', 1847 RawConv => '$val ? $$self{JFIFThumbnailHeight} = $val : undef', 1848 }, 1849 9 => { 1850 Name => 'ThumbnailTIFF', 1851 Groups => { 2 => 'Preview' }, 1852 Format => 'undef[3*($val{7}||0)*($val{8}||0)]', 1853 Notes => 'raw RGB thumbnail data, extracted as a TIFF image', 1854 RawConv => 'length($val) ? $val : undef', 1855 ValueConv => sub { 1856 my ($val, $et) = @_; 1857 my $len = length $val; 1858 return \ "Binary data $len bytes" unless $et->Options('Binary'); 1859 my $img = MakeTiffHeader($$et{JFIFThumbnailWidth},$$et{JFIFThumbnailHeight},3,8) . $val; 1860 return \$img; 1861 }, 1862 }, 1863); 1864%Image::ExifTool::JFIF::Extension = ( 1865 GROUPS => { 0 => 'JFIF', 1 => 'JFXX', 2 => 'Image' }, 1866 NOTES => 'Thumbnail images extracted from the JFXX segment.', 1867 0x10 => { 1868 Name => 'ThumbnailImage', 1869 Groups => { 2 => 'Preview' }, 1870 Notes => 'JPEG-format thumbnail image', 1871 RawConv => '$self->ValidateImage(\$val,$tag)', 1872 }, 1873 0x11 => { # (untested) 1874 Name => 'ThumbnailTIFF', 1875 Groups => { 2 => 'Preview' }, 1876 Notes => 'raw palette-color thumbnail data, extracted as a TIFF image', 1877 RawConv => '(length $val > 770 and $val !~ /^\0\0/) ? $val : undef', 1878 ValueConv => sub { 1879 my ($val, $et) = @_; 1880 my $len = length $val; 1881 return \ "Binary data $len bytes" unless $et->Options('Binary'); 1882 my ($w, $h) = unpack('CC', $val); 1883 my $img = MakeTiffHeader($w,$h,1,8,undef,substr($val,2,768)) . substr($val,770); 1884 return \$img; 1885 }, 1886 }, 1887 0x13 => { 1888 Name => 'ThumbnailTIFF', 1889 Groups => { 2 => 'Preview' }, 1890 Notes => 'raw RGB thumbnail data, extracted as a TIFF image', 1891 RawConv => '(length $val > 2 and $val !~ /^\0\0/) ? $val : undef', 1892 ValueConv => sub { 1893 my ($val, $et) = @_; 1894 my $len = length $val; 1895 return \ "Binary data $len bytes" unless $et->Options('Binary'); 1896 my ($w, $h) = unpack('CC', $val); 1897 my $img = MakeTiffHeader($w,$h,3,8) . substr($val,2); 1898 return \$img; 1899 }, 1900 }, 1901); 1902 1903# Composite tags (accumulation of all Composite tag tables) 1904%Image::ExifTool::Composite = ( 1905 GROUPS => { 0 => 'Composite', 1 => 'Composite' }, 1906 TABLE_NAME => 'Image::ExifTool::Composite', 1907 SHORT_NAME => 'Composite', 1908 VARS => { NO_ID => 1 }, # want empty tagID's for Composite tags 1909 WRITE_PROC => \&DummyWriteProc, 1910); 1911 1912my %compositeID; # lookup for new ID's of Composite tags based on original ID 1913 1914# static private ExifTool variables 1915 1916%allTables = ( ); # list of all tables loaded (except Composite tags) 1917@tableOrder = ( ); # order the tables were loaded 1918 1919#------------------------------------------------------------------------------ 1920# Warning handler routines (warning string stored in $evalWarning) 1921# 1922# Set warning message 1923# Inputs: 0) warning string (undef to reset warning) 1924sub SetWarning($) { $evalWarning = $_[0]; } 1925 1926# Get warning message 1927sub GetWarning() { return $evalWarning; } 1928 1929# Clean unnecessary information (line number, LF) from warning 1930# Inputs: 0) warning string or undef to use $evalWarning 1931# Returns: cleaned warning 1932sub CleanWarning(;$) 1933{ 1934 my $str = shift; 1935 unless (defined $str) { 1936 return undef unless defined $evalWarning; 1937 $str = $evalWarning; 1938 } 1939 $str = $1 if $str =~ /(.*) at /s; 1940 $str =~ s/\s+$//s; 1941 return $str; 1942} 1943 1944#============================================================================== 1945# New - create new ExifTool object 1946# Inputs: 0) reference to exiftool object or ExifTool class name 1947# Returns: blessed ExifTool object ref 1948sub new 1949{ 1950 local $_; 1951 my $that = shift; 1952 my $class = ref($that) || $that || 'Image::ExifTool'; 1953 my $self = bless {}, $class; 1954 1955 # make sure our main Exif tag table has been loaded 1956 GetTagTable("Image::ExifTool::Exif::Main"); 1957 1958 $self->ClearOptions(); # create default options hash 1959 $$self{VALUE} = { }; # must initialize this for warning messages 1960 $$self{PATH} = [ ]; # (this too) 1961 $$self{DEL_GROUP} = { }; # lookup for groups to delete when writing 1962 $$self{SAVE_COUNT} = 0; # count calls to SaveNewValues() 1963 $$self{FILE_SEQUENCE} = 0; # sequence number for files when reading 1964 1965 # initialize our new groups for writing 1966 $self->SetNewGroups(@defaultWriteGroups); 1967 1968 return $self; 1969} 1970 1971#------------------------------------------------------------------------------ 1972# ImageInfo - return specified information from image file 1973# Inputs: 0) [optional] ExifTool object reference 1974# 1) filename, file reference, or scalar data reference 1975# 2-N) list of tag names to find (or tag list reference or options reference) 1976# Returns: reference to hash of tag/value pairs (with "Error" entry on error) 1977# Notes: 1978# - if no tags names are specified, the values of all tags are returned 1979# - tags may be specified with leading '-' to exclude, or trailing '#' for ValueConv 1980# - can pass a reference to list of tags to find, in which case the list will 1981# be updated with the tags found in the proper case and in the specified order. 1982# - can pass reference to hash specifying options 1983# - returned tag values may be scalar references indicating binary data 1984# - see ClearOptions() below for a list of options and their default values 1985# Examples: 1986# use Image::ExifTool 'ImageInfo'; 1987# my $info = ImageInfo($file, 'DateTimeOriginal', 'ImageSize'); 1988# - or - 1989# my $et = new Image::ExifTool; 1990# my $info = $et->ImageInfo($file, \@tagList, {Sort=>'Group0'} ); 1991sub ImageInfo($;@) 1992{ 1993 local $_; 1994 # get our ExifTool object ($self) or create one if necessary 1995 my $self; 1996 if (ref $_[0] and UNIVERSAL::isa($_[0],'Image::ExifTool')) { 1997 $self = shift; 1998 } else { 1999 $self = new Image::ExifTool; 2000 } 2001 my %saveOptions = %{$$self{OPTIONS}}; # save original options 2002 2003 # initialize file information 2004 $$self{FILENAME} = $$self{RAF} = undef; 2005 2006 $self->ParseArguments(@_); # parse our function arguments 2007 $self->ExtractInfo(undef); # extract meta information from image 2008 my $info = $self->GetInfo(undef); # get requested information 2009 2010 $$self{OPTIONS} = \%saveOptions; # restore original options 2011 2012 return $info; # return requested information 2013} 2014 2015#------------------------------------------------------------------------------ 2016# Get/set ExifTool options 2017# Inputs: 0) ExifTool object reference, 2018# 1) Parameter name (case insensitive), 2) Value to set the option 2019# 3-N) More parameter/value pairs 2020# Returns: original value of last option specified 2021sub Options($$;@) 2022{ 2023 local $_; 2024 my $self = shift; 2025 my $options = $$self{OPTIONS}; 2026 my $oldVal; 2027 2028 while (@_) { 2029 my $param = shift; 2030 # fix parameter case if necessary 2031 unless (exists $$options{$param}) { 2032 my ($fixed) = grep /^$param$/i, keys %$options; 2033 if ($fixed) { 2034 $param = $fixed; 2035 } else { 2036 $param =~ s/^Group(\d*)$/Group$1/i; 2037 } 2038 } 2039 $oldVal = $$options{$param}; 2040 if (ref $oldVal eq 'HASH' and ($param eq 'Compact' or $param eq 'XMPShorthand')) { 2041 # get previous Compact/XMPShorthand setting 2042 $oldVal = $$oldVal{$param}; 2043 } 2044 last unless @_; 2045 my $newVal = shift; 2046 if ($param eq 'Lang') { 2047 # allow this to be set to undef to select the default language 2048 $newVal = $defaultLang unless defined $newVal; 2049 if ($newVal eq $defaultLang) { 2050 $$options{$param} = $newVal; 2051 delete $$self{CUR_LANG}; 2052 # make sure the language is available 2053 } elsif (eval "require Image::ExifTool::Lang::$newVal") { 2054 my $xlat = "Image::ExifTool::Lang::${newVal}::Translate"; 2055 no strict 'refs'; 2056 if (%$xlat) { 2057 $$self{CUR_LANG} = \%$xlat; 2058 $$options{$param} = $newVal; 2059 } 2060 } # else don't change Lang 2061 } elsif ($param eq 'Exclude' and defined $newVal) { 2062 # clone Exclude list and expand shortcuts 2063 my @exclude; 2064 if (ref $newVal eq 'ARRAY') { 2065 @exclude = @$newVal; 2066 } else { 2067 @exclude = ($newVal); 2068 } 2069 ExpandShortcuts(\@exclude, 1); # (also remove '#' suffix) 2070 $$options{$param} = \@exclude; 2071 } elsif ($param =~ /^Charset/ or $param eq 'IPTCCharset') { 2072 # only allow valid character sets to be set 2073 if ($newVal) { 2074 my $charset = $charsetName{lc $newVal}; 2075 if ($charset) { 2076 $$options{$param} = $charset; 2077 # maintain backward-compatibility with old IPTCCharset option 2078 $$options{CharsetIPTC} = $charset if $param eq 'IPTCCharset'; 2079 } else { 2080 warn "Invalid Charset $newVal\n"; 2081 } 2082 } elsif ($param eq 'CharsetEXIF' or $param eq 'CharsetFileName' or $param eq 'CharsetRIFF') { 2083 $$options{$param} = $newVal; # only these may be set to a false value 2084 } elsif ($param eq 'CharsetQuickTime') { 2085 $$options{$param} = 'MacRoman'; # QuickTime defaults to MacRoman 2086 } else { 2087 $$options{$param} = 'Latin'; # all others default to Latin 2088 } 2089 } elsif ($param eq 'UserParam') { 2090 # clear options if $newVal is undef 2091 defined $newVal or $$options{$param} = {}, next; 2092 my $table = GetTagTable('Image::ExifTool::UserParam'); 2093 # allow initialization of entire UserParam hash 2094 if (ref $newVal eq 'HASH') { 2095 my %newParams; 2096 foreach (sort keys %$newVal) { 2097 my $lcTag = lc $_; 2098 $newParams{$lcTag} = $$newVal{$_}; 2099 delete $$table{$lcTag}; 2100 AddTagToTable($table, $lcTag, $_); 2101 } 2102 $$options{$param} = \%newParams; 2103 next; 2104 } 2105 my ($force, $paramName); 2106 # set/reset single UserParam parameter 2107 if ($newVal =~ /(.*?)=(.*)/s) { 2108 $paramName = $1; 2109 $newVal = $2; 2110 $force = 1 if $paramName =~ s/\^$//; 2111 $paramName =~ tr/-_a-zA-Z0-9#//dc; 2112 $param = lc $paramName; 2113 } else { 2114 ($param = lc $newVal) =~ tr/-_a-zA-Z0-9#//dc; 2115 undef $newVal; 2116 } 2117 delete $$table{$param}; 2118 $oldVal = $$options{UserParam}{$param}; 2119 if (defined $newVal) { 2120 if (length $newVal or $force) { 2121 $$options{UserParam}{$param} = $newVal; 2122 AddTagToTable($table, $param, $paramName); 2123 } else { 2124 delete $$options{UserParam}{$param}; 2125 } 2126 } 2127 # remove alternate version of tag 2128 $param .= '#' unless $param =~ s/#$//; 2129 delete $$table{$param}; 2130 delete $$options{UserParam}{$param}; 2131 } elsif ($param eq 'RequestTags') { 2132 if (defined $newVal) { 2133 # parse list from delimited string if necessary 2134 my @reqList = (ref $newVal eq 'ARRAY') ? @$newVal : ($newVal =~ /[-\w?*:]+/g); 2135 ExpandShortcuts(\@reqList); 2136 # add to existing list 2137 $$options{$param} or $$options{$param} = [ ]; 2138 foreach (@reqList) { 2139 /^(.*:)?([-\w?*]*)#?$/ or next; 2140 push @{$$options{$param}}, lc($2) if $2; 2141 next unless $1; 2142 # add requested groups with trailing colon 2143 push @{$$options{$param}}, lc($_).':' foreach split /:/, $1; 2144 } 2145 } else { 2146 $$options{$param} = undef; # clear the list 2147 } 2148 } elsif ($param eq 'ListJoin') { 2149 $$options{$param} = $newVal; 2150 # set the old List and ListSep options for backward compatibility 2151 if (defined $newVal) { 2152 $$options{List} = 0; 2153 $$options{ListSep} = $newVal; 2154 } else { 2155 $$options{List} = 1; 2156 # (ListSep must be defined) 2157 } 2158 } elsif ($param eq 'List') { 2159 $$options{$param} = $newVal; 2160 # set the new ListJoin option for forward compatibility 2161 $$options{ListJoin} = $newVal ? undef : $$options{ListSep}; 2162 } elsif ($param eq 'Compact' or $param eq 'XMPShorthand') { 2163 # set Compact and XMPShorthand options, preserving backward compatibility 2164 my ($p, %compact); 2165 foreach $p ('Compact','XMPShorthand') { 2166 my $val = $param eq $p ? $newVal : $$options{Compact}{$p}; 2167 if (defined $val) { 2168 my @v = ($val =~ /\w+/g); 2169 my $opt = ($p eq 'Compact') ? \%compactOpt : \%xmpShorthandOpt; 2170 foreach (@v) { 2171 my $set = $$opt{lc $_} or warn("Invalid $p setting '${_}'\n"), return $oldVal; 2172 ref $set or $compact{$set} = 1, next; 2173 $compact{$_} = 1 foreach @$set; 2174 } 2175 } 2176 $compact{$p} = $val; # preserve most recent setting 2177 } 2178 $$options{Compact} = $$options{XMPShorthand} = \%compact; 2179 } else { 2180 if ($param eq 'Escape') { 2181 # set ESCAPE_PROC 2182 if (defined $newVal and $newVal eq 'XML') { 2183 require Image::ExifTool::XMP; 2184 $$self{ESCAPE_PROC} = \&Image::ExifTool::XMP::EscapeXML; 2185 } elsif (defined $newVal and $newVal eq 'HTML') { 2186 require Image::ExifTool::HTML; 2187 $$self{ESCAPE_PROC} = \&Image::ExifTool::HTML::EscapeHTML; 2188 } else { 2189 delete $$self{ESCAPE_PROC}; 2190 } 2191 # must forget saved values since they depend on Escape method 2192 $$self{BOTH} = { }; 2193 } elsif ($param eq 'GlobalTimeShift') { 2194 delete $$self{GLOBAL_TIME_OFFSET}; # reset our calculated offset 2195 } elsif ($param eq 'TimeZone' and defined $newVal and length $newVal) { 2196 $ENV{TZ} = $newVal; 2197 eval { require POSIX; POSIX::tzset() }; 2198 } elsif ($param eq 'Validate') { 2199 # load Validate module if Validate option enabled 2200 $newVal and require Image::ExifTool::Validate; 2201 } 2202 $$options{$param} = $newVal; 2203 } 2204 } 2205 return $oldVal; 2206} 2207 2208#------------------------------------------------------------------------------ 2209# ClearOptions - set options to default values 2210# Inputs: 0) ExifTool object reference 2211sub ClearOptions($) 2212{ 2213 local $_; 2214 my $self = shift; 2215 2216 # create options hash with default values 2217 # +-----------------------------------------------------+ 2218 # ! DON'T FORGET!! When adding any new option, must ! 2219 # ! decide how it is handled in SetNewValuesFromFile() ! 2220 # +-----------------------------------------------------+ 2221 # (Note: All options must exist in this lookup, even if undefined, 2222 # to facilitate case-insensitive options. 'Group#' is handled specially) 2223 $$self{OPTIONS} = { 2224 Binary => undef, # flag to extract binary values even if tag not specified 2225 ByteOrder => undef, # default byte order when creating EXIF information 2226 Charset => 'UTF8', # character set for converting Unicode characters 2227 CharsetEXIF => undef, # internal EXIF "ASCII" string encoding 2228 CharsetFileName => undef, # external encoding for file names 2229 CharsetID3 => 'Latin', # internal ID3v1 character set 2230 CharsetIPTC => 'Latin', # fallback IPTC character set if no CodedCharacterSet 2231 CharsetPhotoshop => 'Latin', # internal encoding for Photoshop resource names 2232 CharsetQuickTime => 'MacRoman', # internal QuickTime string encoding 2233 CharsetRIFF => 0, # internal RIFF string encoding (0=default to Latin) 2234 Compact => { }, # write compact XMP 2235 Composite => 1, # flag to calculate Composite tags 2236 Compress => undef, # flag to write new values as compressed if possible 2237 CoordFormat => undef, # GPS lat/long coordinate format 2238 DateFormat => undef, # format for date/time 2239 Duplicates => 1, # flag to save duplicate tag values 2240 Escape => undef, # escape special characters 2241 Exclude => undef, # tags to exclude 2242 ExtendedXMP => 1, # strategy for reading extended XMP 2243 ExtractEmbedded =>undef,# flag to extract information from embedded documents 2244 FastScan => undef, # flag to avoid scanning for trailer 2245 Filter => undef, # output filter for all tag values 2246 FilterW => undef, # input filter when writing tag values 2247 FixBase => undef, # fix maker notes base offsets 2248 GeoMaxIntSecs => 1800, # geotag maximum interpolation time (secs) 2249 GeoMaxExtSecs => 1800, # geotag maximum extrapolation time (secs) 2250 GeoMaxHDOP => undef, # geotag maximum HDOP 2251 GeoMaxPDOP => undef, # geotag maximum PDOP 2252 GeoMinSats => undef, # geotag minimum satellites 2253 GeoSpeedRef => undef, # geotag GPSSpeedRef 2254 GlobalTimeShift => undef, # apply time shift to all extracted date/time values 2255 # Group# => undef, # return tags for specified groups in family # 2256 HexTagIDs => 0, # use hex tag ID's in family 7 group names 2257 HtmlDump => 0, # HTML dump (0-3, higher # = bigger limit) 2258 HtmlDumpBase => undef, # base address for HTML dump 2259 IgnoreMinorErrors => undef, # ignore minor errors when reading/writing 2260 Lang => $defaultLang,# localized language for descriptions etc 2261 LargeFileSupport => undef, # flag indicating support of 64-bit file offsets 2262 List => undef, # extract lists of PrintConv values into arrays [no longer documented] 2263 ListItem => undef, # used to return a specific item from lists 2264 ListJoin => ', ', # join lists together with this separator 2265 ListSep => ', ', # list item separator [no longer documented] 2266 ListSplit => undef, # regex for splitting list-type tag values when writing 2267 MakerNotes => undef, # extract maker notes as a block 2268 MDItemTags => undef, # extract MacOS metadata item tags 2269 MissingTagValue =>undef,# value for missing tags when expanded in expressions 2270 NoMultiExif => undef, # raise error when writing multi-segment EXIF 2271 NoPDFList => undef, # flag to avoid splitting PDF List-type tag values 2272 Password => undef, # password for password-protected PDF documents 2273 PrintConv => 1, # flag to enable print conversion 2274 QuickTimeHandler => undef, # flag to add mdir Handler to newly created Meta box 2275 QuickTimeUTC=> undef, # assume that QuickTime date/time tags are stored as UTC 2276 RequestAll => undef, # extract all tags that must be specifically requested 2277 RequestTags => undef, # extra tags to request (on top of those in the tag list) 2278 SaveFormat => undef, # save family 6 tag TIFF format 2279 SavePath => undef, # save family 5 location path 2280 ScanForXMP => undef, # flag to scan for XMP information in all files 2281 Sort => 'Input', # order to sort found tags (Input, File, Tag, Descr, Group#) 2282 Sort2 => 'File', # secondary sort order for tags in a group (File, Tag, Descr) 2283 StrictDate => undef, # flag to return undef for invalid date conversions 2284 Struct => undef, # return structures as hash references 2285 SystemTags => undef, # extract additional File System tags 2286 TextOut => \*STDOUT,# file for Verbose/HtmlDump output 2287 TimeZone => undef, # local time zone 2288 Unknown => 0, # flag to get values of unknown tags (0-2) 2289 UserParam => { }, # user parameters for additional user-defined tag values 2290 Validate => undef, # perform additional validation 2291 Verbose => 0, # print verbose messages (0-5, higher # = more verbose) 2292 WriteMode => 'wcg', # enable all write modes by default 2293 XAttrTags => undef, # extract MacOS extended attribute tags 2294 XMPAutoConv => 1, # automatic conversion of unknown XMP tag values 2295 XMPShorthand=> 0, # (unused, but needed for backward compatibility) 2296 }; 2297 # keep necessary member variables in sync with options 2298 delete $$self{CUR_LANG}; 2299 delete $$self{ESCAPE_PROC}; 2300 2301 # load user-defined default options 2302 if (%Image::ExifTool::UserDefined::Options) { 2303 foreach (keys %Image::ExifTool::UserDefined::Options) { 2304 $self->Options($_, $Image::ExifTool::UserDefined::Options{$_}); 2305 } 2306 } 2307} 2308 2309#------------------------------------------------------------------------------ 2310# Extract meta information from image 2311# Inputs: 0) ExifTool object reference 2312# 1-N) Same as ImageInfo() 2313# Returns: 1 if this was a valid image, 0 otherwise 2314# Notes: pass an undefined value to avoid parsing arguments 2315# Internal 'ReEntry' option allows this routine to be called recursively 2316sub ExtractInfo($;@) 2317{ 2318 local $_; 2319 my $self = shift; 2320 my $options = $$self{OPTIONS}; # pointer to current options 2321 my $fast = $$options{FastScan} || 0; 2322 my $req = $$self{REQ_TAG_LOOKUP}; 2323 my $reqAll = $$options{RequestAll} || 0; 2324 my (%saveOptions, $reEntry, $rsize, $type, @startTime, $saveOrder); 2325 2326 # check for internal ReEntry option to allow recursive calls to ExtractInfo 2327 if (ref $_[1] eq 'HASH' and $_[1]{ReEntry} and 2328 (ref $_[0] eq 'SCALAR' or ref $_[0] eq 'GLOB')) 2329 { 2330 # save necessary members for restoring later 2331 $reEntry = { 2332 RAF => $$self{RAF}, 2333 PROCESSED => $$self{PROCESSED}, 2334 EXIF_DATA => $$self{EXIF_DATA}, 2335 EXIF_POS => $$self{EXIF_POS}, 2336 FILE_TYPE => $$self{FILE_TYPE}, 2337 }; 2338 $saveOrder = GetByteOrder(), 2339 $$self{RAF} = new File::RandomAccess($_[0]); 2340 $$self{PROCESSED} = { }; 2341 delete $$self{EXIF_DATA}; 2342 delete $$self{EXIF_POS}; 2343 } else { 2344 if (defined $_[0] or $$options{HtmlDump} or $$req{validate}) { 2345 %saveOptions = %$options; # save original options 2346 2347 # require duplicates for html dump 2348 $self->Options(Duplicates => 1) if $$options{HtmlDump}; 2349 # enable Validate option if Validate tag is requested 2350 $self->Options(Validate => 1) if $$req{validate}; 2351 2352 if (defined $_[0]) { 2353 # only initialize filename if called with arguments 2354 $$self{FILENAME} = undef; # name of file (or '' if we didn't open it) 2355 $$self{RAF} = undef; # RandomAccess object reference 2356 2357 $self->ParseArguments(@_); # initialize from our arguments 2358 } 2359 } 2360 # initialize ExifTool object members 2361 $self->Init(); 2362 2363 delete $$self{MAKER_NOTE_FIXUP}; # fixup information for extracted maker notes 2364 delete $$self{MAKER_NOTE_BYTE_ORDER}; 2365 2366 # return our version number 2367 $self->FoundTag('ExifToolVersion', "$VERSION$RELEASE"); 2368 $self->FoundTag('Now', $self->TimeNow()) if $$req{now} or $reqAll; 2369 $self->FoundTag('NewGUID', NewGUID()) if $$req{newguid} or $reqAll; 2370 # generate sequence number if necessary 2371 $self->FoundTag('FileSequence', $$self{FILE_SEQUENCE}) if $$req{filesequence} or $reqAll; 2372 2373 if ($$req{processingtime} or $reqAll) { 2374 eval { require Time::HiRes; @startTime = Time::HiRes::gettimeofday() }; 2375 if (not @startTime and $$req{processingtime}) { 2376 $self->WarnOnce('Install Time::HiRes to generate ProcessingTime'); 2377 } 2378 } 2379 2380 ++$$self{FILE_SEQUENCE}; # count files read 2381 } 2382 2383 my $filename = $$self{FILENAME}; # image file name ('' if already open) 2384 my $raf = $$self{RAF}; # RandomAccess object 2385 2386 local *EXIFTOOL_FILE; # avoid clashes with global namespace 2387 2388 my $realname = $filename; 2389 unless ($raf) { 2390 # save file name 2391 if (defined $filename and $filename ne '') { 2392 unless ($filename eq '-') { 2393 # extract file name from pipe if necessary 2394 $realname =~ /\|$/ and $realname =~ s/^.*?"(.*?)".*/$1/s; 2395 my ($dir, $name) = SplitFileName($realname); 2396 $self->FoundTag('FileName', $name); 2397 $self->FoundTag('Directory', $dir) if defined $dir and length $dir; 2398 if ($$req{filepath} or 2399 ($reqAll and not $$self{EXCL_TAG_LOOKUP}{filepath})) 2400 { 2401 local $SIG{'__WARN__'} = \&SetWarning; 2402 if (eval { require Cwd }) { 2403 my $path = eval { Cwd::abs_path($filename) }; 2404 $self->FoundTag('FilePath', $path) if defined $path; 2405 } elsif ($$req{filepath}) { 2406 $self->WarnOnce('The Perl Cwd module must be installed to use FilePath'); 2407 } 2408 } 2409 # get size of resource fork on Mac OS 2410 $rsize = -s "$filename/..namedfork/rsrc" if $^O eq 'darwin' and not $$self{IN_RESOURCE}; 2411 } 2412 # open the file 2413 if ($self->Open(\*EXIFTOOL_FILE, $filename)) { 2414 # create random access file object 2415 $raf = new File::RandomAccess(\*EXIFTOOL_FILE); 2416 # patch to force pipe to be buffered because seek returns success 2417 # in Windows cmd shell pipe even though it really failed 2418 $$raf{TESTED} = -1 if $filename eq '-' or $filename =~ /\|$/; 2419 $$self{RAF} = $raf; 2420 } else { 2421 $self->Error('Error opening file'); 2422 } 2423 } else { 2424 $self->Error('No file specified'); 2425 } 2426 } 2427 2428 while ($raf) { 2429 my (@stat, $fileSize); 2430 if ($reEntry) { 2431 # we already set these tags 2432 } elsif (not $$raf{FILE_PT}) { 2433 # get file size from image in memory 2434 $self->FoundTag('FileSize', length ${$$raf{BUFF_PT}}); 2435 } elsif (-f $$raf{FILE_PT}) { 2436 # get file tags if this is a plain file 2437 $fileSize = -s _; 2438 @stat = stat _; 2439 my ($aTime, $mTime, $cTime) = $self->GetFileTime($$raf{FILE_PT}); 2440 $self->FoundTag('FileSize', $fileSize) if defined $fileSize; 2441 $self->FoundTag('ResourceForkSize', $rsize) if $rsize; 2442 $self->FoundTag('FileModifyDate', $mTime) if defined $mTime; 2443 $self->FoundTag('FileAccessDate', $aTime) if defined $aTime; 2444 my $cTag = $^O eq 'MSWin32' ? 'FileCreateDate' : 'FileInodeChangeDate'; 2445 $self->FoundTag($cTag, $cTime) if defined $cTime; 2446 $self->FoundTag('FilePermissions', $stat[2]) if defined $stat[2]; 2447 } else { 2448 @stat = stat $$raf{FILE_PT}; 2449 } 2450 # extract more system info if SystemTags option is set 2451 if (@stat) { 2452 my $sys = $$options{SystemTags} || ($reqAll and not defined $$options{SystemTags}); 2453 if ($sys or $$req{fileattributes}) { 2454 my @attr = ($stat[2] & 0xf000, $stat[2] & 0x0e00); 2455 # add Windows file attributes if available 2456 if ($^O eq 'MSWin32' and defined $filename and $filename ne '' and $filename ne '-') { 2457 local $SIG{'__WARN__'} = \&SetWarning; 2458 if (eval { require Win32API::File }) { 2459 my $wattr; 2460 my $file = $filename; 2461 if ($self->EncodeFileName($file)) { 2462 $wattr = eval { Win32API::File::GetFileAttributesW($file) }; 2463 } else { 2464 $wattr = eval { Win32API::File::GetFileAttributes($file) }; 2465 } 2466 push @attr, $wattr if defined $wattr and $wattr != 0xffffffff; 2467 } 2468 } 2469 $self->FoundTag('FileAttributes', "@attr"); 2470 } 2471 $self->FoundTag('FileDeviceNumber', $stat[0]) if $sys or $$req{filedevicenumber}; 2472 $self->FoundTag('FileInodeNumber', $stat[1]) if $sys or $$req{fileinodenumber}; 2473 $self->FoundTag('FileHardLinks', $stat[3]) if $sys or $$req{filehardlinks}; 2474 $self->FoundTag('FileUserID', $stat[4]) if $sys or $$req{fileuserid}; 2475 $self->FoundTag('FileGroupID', $stat[5]) if $sys or $$req{filegroupid}; 2476 $self->FoundTag('FileDeviceID', $stat[6]) if $sys or $$req{filedeviceid}; 2477 $self->FoundTag('FileBlockSize', $stat[11]) if $sys or $$req{fileblocksize}; 2478 $self->FoundTag('FileBlockCount', $stat[12]) if $sys or $$req{fileblockcount}; 2479 } 2480 # extract MDItem tags if requested (only on plain files) 2481 if ($^O eq 'darwin' and defined $filename and $filename ne '' and defined $fileSize) { 2482 my $reqMacOS = ($reqAll > 1 or $$req{'macos:'}); 2483 my $crDate = ($reqMacOS || $$req{filecreatedate}); 2484 my $mdItem = ($reqMacOS || $$options{MDItemTags} || grep /^mditem/, keys %$req); 2485 my $xattr = ($reqMacOS || $$options{XAttrTags} || grep /^xattr/, keys %$req); 2486 if ($crDate or $mdItem or $xattr) { 2487 require Image::ExifTool::MacOS; 2488 Image::ExifTool::MacOS::GetFileCreateDate($self, $filename) if $crDate; 2489 Image::ExifTool::MacOS::ExtractMDItemTags($self, $filename) if $mdItem; 2490 Image::ExifTool::MacOS::ExtractXAttrTags($self, $filename) if $xattr; 2491 } 2492 } 2493 2494 # get list of file types to check 2495 my ($tiffType, %noMagic, $recognizedExt); 2496 my $ext = $$self{FILE_EXT} = GetFileExtension($realname); 2497 # set $recognizedExt if this file type is recognized by extension only 2498 $recognizedExt = $ext if defined $ext and not defined $magicNumber{$ext} and 2499 defined $moduleName{$ext} and not $moduleName{$ext}; 2500 my @fileTypeList = GetFileType($realname); 2501 if ($fast >= 4) { 2502 if (@fileTypeList) { 2503 $type = shift @fileTypeList; 2504 $self->SetFileType($$self{FILE_TYPE} = $type); 2505 } else { 2506 $self->Error('Unknown file type'); 2507 } 2508 $self->BuildCompositeTags() if $fast == 4 and $$options{Composite}; 2509 last; # don't read the file 2510 } 2511 if (@fileTypeList) { 2512 # add remaining types to end of list so we test them all 2513 my $pat = join '|', @fileTypeList; 2514 push @fileTypeList, grep(!/^($pat)$/, @fileTypes); 2515 $tiffType = $$self{FILE_EXT}; 2516 unless ($fast == 3) { 2517 $noMagic{MXF} = 1; # don't do magic number test on MXF or DV files 2518 $noMagic{DV} = 1; 2519 } 2520 } else { 2521 # scan through all recognized file types 2522 @fileTypeList = @fileTypes; 2523 $tiffType = 'TIFF'; 2524 } 2525 push @fileTypeList, ''; # end of list marker 2526 # initialize the input file for seeking in binary data 2527 $raf->BinMode(); # set binary mode before we start reading 2528 my $pos = $raf->Tell(); # get file position so we can rewind 2529 # loop through list of file types to test 2530 my ($buff, $seekErr); 2531 my %dirInfo = ( RAF => $raf, Base => $pos, TestBuff => \$buff ); 2532 # read start of file for testing 2533 $raf->Read($buff, $testLen) or $buff = ''; 2534 $raf->Seek($pos, 0) or $seekErr = 1; 2535 until ($seekErr) { 2536 my $unkHeader; 2537 $type = shift @fileTypeList; 2538 if ($type) { 2539 if ($magicNumber{$type}) { 2540 # do quick test for this file type to avoid loading module unnecessarily 2541 next if $buff !~ /^$magicNumber{$type}/s and not $noMagic{$type}; 2542 } else { 2543 # keep checking for other types if we recognize this file only by extension 2544 next if defined $moduleName{$type} and not $moduleName{$type}; 2545 next if $fast > 2; # keep checking if we aren't processing the file 2546 } 2547 next if $weakMagic{$type} and defined $recognizedExt; 2548 } elsif (not defined $type) { 2549 last; 2550 } elsif ($recognizedExt) { 2551 $type = $recognizedExt; # set type from recognized file extension only 2552 } else { 2553 # last ditch effort to scan past unknown header for JPEG/TIFF 2554 next unless $buff =~ /(\xff\xd8\xff|MM\0\x2a|II\x2a\0)/g; 2555 $type = ($1 eq "\xff\xd8\xff") ? 'JPEG' : 'TIFF'; 2556 my $skip = pos($buff) - length($1); 2557 $dirInfo{Base} = $pos + $skip; 2558 $raf->Seek($pos + $skip, 0) or $seekErr = 1, last; 2559 $self->Warn("Processing $type-like data after unknown $skip-byte header"); 2560 $unkHeader = 1 unless $$self{DOC_NUM}; 2561 } 2562 # save file type in member variable 2563 $$self{FILE_TYPE} = $type; 2564 $dirInfo{Parent} = ($type eq 'TIFF') ? $tiffType : $type; 2565 # don't process the file when FastScan == 3 2566 if ($fast == 3 and not $processType{$type}) { 2567 unless ($weakMagic{$type} and (not $ext or $ext ne $type)) { 2568 $self->SetFileType($dirInfo{Parent}); 2569 } 2570 last; 2571 } 2572 my $module = $moduleName{$type}; 2573 $module = $type unless defined $module; 2574 my $func = "Process$type"; 2575 2576 # load module if necessary 2577 if ($module) { 2578 require "Image/ExifTool/$module.pm"; 2579 $func = "Image::ExifTool::${module}::$func"; 2580 } elsif ($module eq '0') { 2581 $self->SetFileType(); 2582 $self->Warn('Unsupported file type'); 2583 last; 2584 } 2585 push @{$$self{PATH}}, $type; # save file type in metadata PATH 2586 2587 # process the file 2588 no strict 'refs'; 2589 my $result = &$func($self, \%dirInfo); 2590 use strict 'refs'; 2591 2592 pop @{$$self{PATH}}; 2593 2594 if ($result) { # all done if successful 2595 if ($unkHeader) { 2596 $self->DeleteTag('FileType'); 2597 $self->DeleteTag('FileTypeExtension'); 2598 $self->DeleteTag('MIMEType'); 2599 $self->VPrint(0,"Reset file type due to unknown header\n"); 2600 } 2601 last; 2602 } 2603 # seek back to try again from the same position in the file 2604 $raf->Seek($pos, 0) or $seekErr = 1, last; 2605 } 2606 if (not defined $type and not $$self{DOC_NUM}) { 2607 # if we were given a single image with a known type there 2608 # must be a format error since we couldn't read it, otherwise 2609 # it is likely we don't support images of this type 2610 my $fileType = GetFileType($realname) || ''; 2611 my $err; 2612 if (not length $buff) { 2613 $err = 'File is empty'; 2614 } else { 2615 my $ch = substr($buff, 0, 1); 2616 if (length $buff < 16 or $buff =~ /[^\Q$ch\E]/) { 2617 if ($fileType eq 'RAW') { 2618 $err = 'Unsupported RAW file type'; 2619 } elsif ($fileType) { 2620 $err = 'File format error'; 2621 } else { 2622 $err = 'Unknown file type'; 2623 } 2624 } else { 2625 # provide some insight into the content of some corrupted files 2626 if ($$self{OPTIONS}{FastScan}) { 2627 $err = 'File header is all'; 2628 } else { 2629 my $num = 0; 2630 for (;;) { 2631 $raf->Read($buff, 65536) or undef($num), last; 2632 $buff =~ /[^\Q$ch\E]/g and $num += pos($buff) - 1, last; 2633 $num += length($buff); 2634 } 2635 if ($num) { 2636 $err = 'First ' . ConvertFileSize($num) . ' of file is'; 2637 } else { 2638 $err = 'Entire file is'; 2639 } 2640 } 2641 if ($ch eq "\0") { 2642 $err .= ' binary zeros'; 2643 } elsif ($ch eq ' ') { 2644 $err .= ' ASCII spaces'; 2645 } elsif ($ch =~ /[a-zA-Z0-9]/) { 2646 $err .= " ASCII '${ch}' characters"; 2647 } else { 2648 $err .= sprintf(" binary 0x%.2x's", ord $ch); 2649 } 2650 } 2651 } 2652 $self->Error($err); 2653 } 2654 if ($seekErr) { 2655 $self->Error('Error seeking in file'); 2656 } elsif ($self->Options('ScanForXMP') and (not defined $type or 2657 (not $fast and not $$self{FoundXMP}))) 2658 { 2659 # scan for XMP 2660 $raf->Seek($pos, 0); 2661 require Image::ExifTool::XMP; 2662 Image::ExifTool::XMP::ScanForXMP($self, $raf) and $type = ''; 2663 } 2664 # extract binary EXIF data block only if requested 2665 if (defined $$self{EXIF_DATA} and length $$self{EXIF_DATA} > 16 and 2666 ($$req{exif} or 2667 # (not extracted normally, so check TAGS_FROM_FILE) 2668 ($$self{TAGS_FROM_FILE} and not $$self{EXCL_TAG_LOOKUP}{exif}))) 2669 { 2670 $self->FoundTag('EXIF', $$self{EXIF_DATA}); 2671 } 2672 unless ($reEntry) { 2673 $$self{PATH} = [ ]; # reset PATH 2674 # calculate Composite tags 2675 $self->BuildCompositeTags() if $$options{Composite}; 2676 # do our HTML dump if requested 2677 if ($$self{HTML_DUMP}) { 2678 $raf->Seek(0, 2); # seek to end of file 2679 $$self{HTML_DUMP}->FinishTiffDump($self, $raf->Tell()); 2680 my $pos = $$options{HtmlDumpBase}; 2681 $pos = ($$self{FIRST_EXIF_POS} || 0) unless defined $pos; 2682 my $dataPt = defined $$self{EXIF_DATA} ? \$$self{EXIF_DATA} : undef; 2683 undef $dataPt if defined $$self{EXIF_POS} and $pos != $$self{EXIF_POS}; 2684 undef $dataPt if $$self{ExtendedEXIF}; # can't use EXIF block if not contiguous 2685 my $success = $$self{HTML_DUMP}->Print($raf, $dataPt, $pos, 2686 $$options{TextOut}, $$options{HtmlDump}, 2687 $$self{FILENAME} ? "HTML Dump ($$self{FILENAME})" : 'HTML Dump'); 2688 $self->Warn("Error reading $$self{HTML_DUMP}{ERROR}") if $success < 0; 2689 } 2690 } 2691 if ($filename) { 2692 $raf->Close(); # close the file if we opened it 2693 # process the resource fork as an embedded file on Mac filesystems 2694 if ($rsize and $$options{ExtractEmbedded}) { 2695 local *RESOURCE_FILE; 2696 if ($self->Open(\*RESOURCE_FILE, "$filename/..namedfork/rsrc")) { 2697 $$self{DOC_NUM} = $$self{DOC_COUNT} + 1; 2698 $$self{IN_RESOURCE} = 1; 2699 $self->ExtractInfo(\*RESOURCE_FILE, { ReEntry => 1 }); 2700 close RESOURCE_FILE; 2701 delete $$self{IN_RESOURCE}; 2702 } else { 2703 $self->Warn('Error opening resource fork'); 2704 } 2705 } 2706 } 2707 last; # (loop was a cheap "goto") 2708 } 2709 2710 # generate Validate tag if requested 2711 if ($$options{Validate} and not $reEntry) { 2712 Image::ExifTool::Validate::FinishValidate($self, $$req{validate}); 2713 } 2714 2715 @startTime and $self->FoundTag('ProcessingTime', Time::HiRes::tv_interval(\@startTime)); 2716 2717 # add user-defined parameters that ended with '!' 2718 if (%{$$options{UserParam}}) { 2719 my $doMsg = $$options{Verbose}; 2720 my $table = GetTagTable('Image::ExifTool::UserParam'); 2721 foreach (sort keys %{$$options{UserParam}}) { 2722 next unless /#$/; 2723 if ($doMsg) { 2724 $self->VPrint(0, "UserParam tags:\n"); 2725 undef $doMsg; 2726 } 2727 $self->HandleTag($table, $_, $$options{UserParam}{$_}); 2728 } 2729 } 2730 2731 # restore original options 2732 %saveOptions and $$self{OPTIONS} = \%saveOptions; 2733 2734 if ($reEntry) { 2735 # restore necessary members when exiting re-entrant code 2736 $$self{$_} = $$reEntry{$_} foreach keys %$reEntry; 2737 SetByteOrder($saveOrder); 2738 } 2739 2740 # ($type may be undef without an Error when processing sub-documents) 2741 return 0 if not defined $type or exists $$self{VALUE}{Error}; 2742 return 1; 2743} 2744 2745#------------------------------------------------------------------------------ 2746# Get hash of extracted meta information 2747# Inputs: 0) ExifTool object reference 2748# 1-N) options hash reference, tag list reference or tag names 2749# Returns: Reference to information hash 2750# Notes: - pass an undefined value to avoid parsing arguments 2751# - If groups are specified, first groups take precedence if duplicate 2752# tags found but Duplicates option not set. 2753# - tag names may end in '#' to extract ValueConv value 2754sub GetInfo($;@) 2755{ 2756 local $_; 2757 my $self = shift; 2758 my %saveOptions; 2759 2760 unless (@_ and not defined $_[0]) { 2761 %saveOptions = %{$$self{OPTIONS}}; # save original options 2762 # must set FILENAME so it isn't parsed from the arguments 2763 $$self{FILENAME} = '' unless defined $$self{FILENAME}; 2764 $self->ParseArguments(@_); 2765 } 2766 2767 # get reference to list of tags for which we will return info 2768 my ($rtnTags, $byValue, $wildTags) = $self->SetFoundTags(); 2769 2770 # build hash of tag information 2771 my (%info, %ignored); 2772 my $conv = $$self{OPTIONS}{PrintConv} ? 'PrintConv' : 'ValueConv'; 2773 foreach (@$rtnTags) { 2774 my $val = $self->GetValue($_, $conv); 2775 defined $val or $ignored{$_} = 1, next; 2776 $info{$_} = $val; 2777 } 2778 2779 # override specified tags with ValueConv value if necessary 2780 if (@$byValue) { 2781 # first determine the number of times each non-ValueConv value is used 2782 my %nonVal; 2783 $nonVal{$_} = ($nonVal{$_} || 0) + 1 foreach @$rtnTags; 2784 --$nonVal{$$rtnTags[$_]} foreach @$byValue; 2785 # loop through ValueConv tags, updating tag keys and returned values 2786 foreach (@$byValue) { 2787 my $tag = $$rtnTags[$_]; 2788 my $val = $self->GetValue($tag, 'ValueConv'); 2789 next unless defined $val; 2790 my $vtag = $tag; 2791 # generate a new tag key like "Tag #" or "Tag #(1)" 2792 $vtag =~ s/( |$)/ #/; 2793 unless (defined $$self{VALUE}{$vtag}) { 2794 $$self{VALUE}{$vtag} = $$self{VALUE}{$tag}; 2795 $$self{TAG_INFO}{$vtag} = $$self{TAG_INFO}{$tag}; 2796 $$self{TAG_EXTRA}{$vtag} = $$self{TAG_EXTRA}{$tag}; 2797 $$self{FILE_ORDER}{$vtag} = $$self{FILE_ORDER}{$tag}; 2798 # remove existing PrintConv entry unless we are using it too 2799 delete $info{$tag} unless $nonVal{$tag}; 2800 } 2801 $$rtnTags[$_] = $vtag; # store ValueConv value with new tag key 2802 $info{$vtag} = $val; # return ValueConv value 2803 } 2804 } 2805 2806 # remove ignored tags from the list 2807 my $reqTags = $$self{REQUESTED_TAGS} || [ ]; 2808 if (%ignored) { 2809 if (not @$reqTags) { 2810 my @goodTags; 2811 foreach (@$rtnTags) { 2812 push @goodTags, $_ unless $ignored{$_}; 2813 } 2814 $rtnTags = $$self{FOUND_TAGS} = \@goodTags; 2815 } elsif (@$wildTags) { 2816 # only remove tags specified by wildcard 2817 my @goodTags; 2818 my $i = 0; 2819 foreach (@$rtnTags) { 2820 if (@$wildTags and $i == $$wildTags[0]) { 2821 shift @$wildTags; 2822 push @goodTags, $_ unless $ignored{$_}; 2823 } else { 2824 push @goodTags, $_; 2825 } 2826 ++$i; 2827 } 2828 $rtnTags = $$self{FOUND_TAGS} = \@goodTags; 2829 } 2830 } 2831 2832 # return sorted tag list if provided with a list reference 2833 if ($$self{IO_TAG_LIST}) { 2834 # use file order by default if no tags specified 2835 # (no such thing as 'Input' order in this case) 2836 my $sort = $$self{OPTIONS}{Sort}; 2837 $sort = 'File' unless @$reqTags or ($sort and $sort ne 'Input'); 2838 # return tags in specified sort order 2839 @{$$self{IO_TAG_LIST}} = $self->GetTagList($rtnTags, $sort, $$self{OPTIONS}{Sort2}); 2840 } 2841 2842 # restore original options 2843 %saveOptions and $$self{OPTIONS} = \%saveOptions; 2844 2845 return \%info; 2846} 2847 2848#------------------------------------------------------------------------------ 2849# Inputs: 0) ExifTool object reference 2850# 1) [optional] reference to info hash or tag list ref (default is found tags) 2851# 2) [optional] sort order ('File', 'Input', ...) 2852# 3) [optional] secondary sort order 2853# Returns: List of tags in specified order 2854sub GetTagList($;$$$) 2855{ 2856 local $_; 2857 my ($self, $info, $sort, $sort2) = @_; 2858 2859 my $foundTags; 2860 if (ref $info eq 'HASH') { 2861 my @tags = keys %$info; 2862 $foundTags = \@tags; 2863 } elsif (ref $info eq 'ARRAY') { 2864 $foundTags = $info; 2865 } 2866 my $fileOrder = $$self{FILE_ORDER}; 2867 2868 if ($foundTags) { 2869 # make sure a FILE_ORDER entry exists for all tags 2870 # (note: already generated bogus entries for FOUND_TAGS case below) 2871 foreach (@$foundTags) { 2872 next if defined $$fileOrder{$_}; 2873 $$fileOrder{$_} = 999; 2874 } 2875 } else { 2876 $sort = $info if $info and not $sort; 2877 $foundTags = $$self{FOUND_TAGS} || $self->SetFoundTags() or return undef; 2878 } 2879 $sort or $sort = $$self{OPTIONS}{Sort}; 2880 2881 # return original list if no sort order specified 2882 return @$foundTags unless $sort and $sort ne 'Input'; 2883 2884 if ($sort eq 'Tag' or $sort eq 'Alpha') { 2885 return sort @$foundTags; 2886 } elsif ($sort =~ /^Group(\d*(:\d+)*)/) { 2887 my $family = $1 || 0; 2888 # want to maintain a basic file order with the groups 2889 # ordered in the way they appear in the file 2890 my (%groupCount, %groupOrder); 2891 my $numGroups = 0; 2892 my $tag; 2893 foreach $tag (sort { $$fileOrder{$a} <=> $$fileOrder{$b} } @$foundTags) { 2894 my $group = $self->GetGroup($tag, $family); 2895 my $num = $groupCount{$group}; 2896 $num or $num = $groupCount{$group} = ++$numGroups; 2897 $groupOrder{$tag} = $num; 2898 } 2899 $sort2 or $sort2 = $$self{OPTIONS}{Sort2}; 2900 if ($sort2) { 2901 if ($sort2 eq 'Tag' or $sort2 eq 'Alpha') { 2902 return sort { $groupOrder{$a} <=> $groupOrder{$b} or $a cmp $b } @$foundTags; 2903 } elsif ($sort2 eq 'Descr') { 2904 my $desc = $self->GetDescriptions($foundTags); 2905 return sort { $groupOrder{$a} <=> $groupOrder{$b} or 2906 $$desc{$a} cmp $$desc{$b} } @$foundTags; 2907 } 2908 } 2909 return sort { $groupOrder{$a} <=> $groupOrder{$b} or 2910 $$fileOrder{$a} <=> $$fileOrder{$b} } @$foundTags; 2911 } elsif ($sort eq 'Descr') { 2912 my $desc = $self->GetDescriptions($foundTags); 2913 return sort { $$desc{$a} cmp $$desc{$b} } @$foundTags; 2914 } else { 2915 return sort { $$fileOrder{$a} <=> $$fileOrder{$b} } @$foundTags; 2916 } 2917} 2918 2919#------------------------------------------------------------------------------ 2920# Get list of found tags in specified sort order 2921# Inputs: 0) ExifTool object reference, 1) sort order ('File', 'Input', ...) 2922# 2) secondary sort order 2923# Returns: List of tag keys in specified order 2924# Notes: If not specified, sort order is taken from OPTIONS 2925sub GetFoundTags($;$$) 2926{ 2927 local $_; 2928 my ($self, $sort, $sort2) = @_; 2929 my $foundTags = $$self{FOUND_TAGS} || $self->SetFoundTags() or return undef; 2930 return $self->GetTagList($foundTags, $sort, $sort2); 2931} 2932 2933#------------------------------------------------------------------------------ 2934# Get list of requested tags 2935# Inputs: 0) ExifTool object reference 2936# Returns: List of requested tag keys 2937sub GetRequestedTags($) 2938{ 2939 local $_; 2940 return @{$_[0]{REQUESTED_TAGS}}; 2941} 2942 2943#------------------------------------------------------------------------------ 2944# Get tag value 2945# Inputs: 0) ExifTool object reference 2946# 1) tag key or tag name with optional group names (case sensitive) 2947# (or flattened tagInfo for getting field values, not part of public API) 2948# 2) [optional] Value type: PrintConv, ValueConv, Both, Raw or Rational, the default 2949# is PrintConv or ValueConv, depending on the PrintConv option setting 2950# 3) raw field value (not part of public API) 2951# Returns: Scalar context: tag value or undefined 2952# List context: list of values or empty list 2953sub GetValue($$;$) 2954{ 2955 local $_; 2956 my ($self, $tag, $type) = @_; # plus: ($fieldValue) 2957 my (@convTypes, $tagInfo, $valueConv, $both); 2958 my $rawValue = $$self{VALUE}; 2959 2960 # get specific tag key if tag has a group name 2961 if ($tag =~ /^(.*):(.+)/) { 2962 my ($gp, $tg) = ($1, $2); 2963 my ($i, $key, @keys); 2964 # build list of tag keys in the order of priority (no index 2965 # is top priority, otherwise higher index is higher priority) 2966 for ($key=$tg, $i=$$self{DUPL_TAG}{$tg} || 0; ; --$i) { 2967 push @keys, $key if defined $$rawValue{$key}; 2968 last if $i <= 0; 2969 $key = "$tg ($i)"; 2970 } 2971 if (@keys) { 2972 $key = $self->GroupMatches($gp, \@keys); 2973 $tag = $key if $key; 2974 } 2975 } 2976 # figure out what conversions to do 2977 if ($type) { 2978 return $$self{RATIONAL}{$tag} if $type eq 'Rational'; 2979 } else { 2980 $type = $$self{OPTIONS}{PrintConv} ? 'PrintConv' : 'ValueConv'; 2981 } 2982 2983 # start with the raw value 2984 my $value = $$rawValue{$tag}; 2985 if (not defined $value) { 2986 return () unless ref $tag; 2987 # get the value of a structure field 2988 $tagInfo = $tag; 2989 $tag = $$tagInfo{Name}; 2990 $value = $_[3]; 2991 # (note: type "Both" is not allowed for structure fields) 2992 if ($type ne 'Raw') { 2993 push @convTypes, 'ValueConv'; 2994 push @convTypes, 'PrintConv' unless $type eq 'ValueConv'; 2995 } 2996 } else { 2997 $tagInfo = $$self{TAG_INFO}{$tag}; 2998 if ($$tagInfo{Struct} and ref $value) { 2999 # must load XMPStruct.pl just in case (should already be loaded if 3000 # a structure was extracted, but we could also arrive here if a simple 3001 # list of values was stored incorrectly in a Struct tag) 3002 require 'Image/ExifTool/XMPStruct.pl'; 3003 # convert strucure field values 3004 unless ($type eq 'Both') { 3005 # (note: ConvertStruct handles the filtering and escaping too if necessary) 3006 return Image::ExifTool::XMP::ConvertStruct($self,$tagInfo,$value,$type); 3007 } 3008 $valueConv = Image::ExifTool::XMP::ConvertStruct($self,$tagInfo,$value,'ValueConv'); 3009 $value = Image::ExifTool::XMP::ConvertStruct($self,$tagInfo,$value,'PrintConv'); 3010 # (must not save these in $$self{BOTH} because the values may have been escaped) 3011 return ($valueConv, $value); 3012 } 3013 if ($type ne 'Raw') { 3014 # use values we calculated already if we stored them 3015 $both = $$self{BOTH}{$tag}; 3016 if ($both) { 3017 if ($type eq 'PrintConv') { 3018 $value = $$both[1]; 3019 } elsif ($type eq 'ValueConv') { 3020 $value = $$both[0]; 3021 $value = $$both[1] unless defined $value; 3022 } else { 3023 ($valueConv, $value) = @$both; 3024 } 3025 } else { 3026 push @convTypes, 'ValueConv'; 3027 push @convTypes, 'PrintConv' unless $type eq 'ValueConv'; 3028 } 3029 } 3030 } 3031 3032 # do the conversions 3033 my (@val, @prt, @raw, $convType); 3034 foreach $convType (@convTypes) { 3035 # don't convert a scalar reference or structure 3036 last if ref $value eq 'SCALAR' and not $$tagInfo{ConvertBinary}; 3037 my $conv = $$tagInfo{$convType}; 3038 unless (defined $conv) { 3039 if ($convType eq 'ValueConv') { 3040 next unless $$tagInfo{Binary}; 3041 $conv = '\$val'; # return scalar reference for binary values 3042 } else { 3043 # use PRINT_CONV from tag table if PrintConv doesn't exist 3044 next unless defined($conv = $$tagInfo{Table}{PRINT_CONV}); 3045 next if exists $$tagInfo{$convType}; 3046 } 3047 } 3048 # save old ValueConv value if we want Both 3049 $valueConv = $value if $type eq 'Both' and $convType eq 'PrintConv'; 3050 my ($i, $val, $vals, @values, $convList); 3051 # split into list if conversion is an array 3052 if (ref $conv eq 'ARRAY') { 3053 $convList = $conv; 3054 $conv = $$convList[0]; 3055 my @valList = (ref $value eq 'ARRAY') ? @$value : split ' ', $value; 3056 # reorganize list if specified (Note: The writer currently doesn't 3057 # relist values, so they may be grouped but the order must not change) 3058 my $relist = $$tagInfo{Relist}; 3059 if ($relist) { 3060 my (@newList, $oldIndex); 3061 foreach $oldIndex (@$relist) { 3062 my ($newVal, @join); 3063 if (ref $oldIndex) { 3064 foreach (@$oldIndex) { 3065 push @join, $valList[$_] if defined $valList[$_]; 3066 } 3067 $newVal = join(' ', @join) if @join; 3068 } else { 3069 $newVal = $valList[$oldIndex]; 3070 } 3071 push @newList, $newVal if defined $newVal; 3072 } 3073 $value = \@newList; 3074 } else { 3075 $value = \@valList; 3076 } 3077 return () unless @$value; 3078 } 3079 # initialize array so we can iterate over values in list 3080 if (ref $value eq 'ARRAY') { 3081 if (defined $$tagInfo{RawJoin}) { 3082 $val = join ' ', @$value; 3083 } else { 3084 $i = 0; 3085 $vals = $value; 3086 $val = $$vals[0]; 3087 } 3088 } else { 3089 $val = $value; 3090 } 3091 # loop through all values in list 3092 for (;;) { 3093 if (defined $conv) { 3094 # get values of required tags if this is a Composite tag 3095 if (ref $val eq 'HASH' and not @val) { 3096 # disable escape of source values so we don't double escape them 3097 my $oldEscape = $$self{ESCAPE_PROC}; 3098 delete $$self{ESCAPE_PROC}; 3099 # temporarily delete filter so it isn't applied to the Require'd values 3100 my $oldFilter = $$self{OPTIONS}{Filter}; 3101 delete $$self{OPTIONS}{Filter}; 3102 foreach (keys %$val) { 3103 next unless defined $$val{$_}; 3104 $raw[$_] = $$rawValue{$$val{$_}}; 3105 ($val[$_], $prt[$_]) = $self->GetValue($$val{$_}, 'Both'); 3106 next if defined $val[$_] or not $$tagInfo{Require}{$_}; 3107 $$self{OPTIONS}{Filter} = $oldFilter if defined $oldFilter; 3108 $$self{ESCAPE_PROC} = $oldEscape; 3109 return (); 3110 } 3111 $$self{OPTIONS}{Filter} = $oldFilter if defined $oldFilter; 3112 $$self{ESCAPE_PROC} = $oldEscape; 3113 # set $val to $val[0], or \@val for a CODE ref conversion 3114 $val = ref $conv eq 'CODE' ? \@val : $val[0]; 3115 } 3116 if (ref $conv eq 'HASH') { 3117 # look up converted value in hash 3118 if (not defined($value = $$conv{$val})) { 3119 if ($$conv{BITMASK}) { 3120 $value = DecodeBits($val, $$conv{BITMASK}, $$tagInfo{BitsPerWord}); 3121 } else { 3122 # use alternate conversion routine if available 3123 if ($$conv{OTHER}) { 3124 local $SIG{'__WARN__'} = \&SetWarning; 3125 undef $evalWarning; 3126 $value = &{$$conv{OTHER}}($val, undef, $conv); 3127 $self->Warn("$convType $tag: " . CleanWarning()) if $evalWarning; 3128 } 3129 if (not defined $value) { 3130 if ($$tagInfo{PrintHex} and $val and IsInt($val) and 3131 $convType eq 'PrintConv') 3132 { 3133 $value = sprintf('Unknown (0x%x)',$val); 3134 } else { 3135 $value = "Unknown ($val)"; 3136 } 3137 } 3138 } 3139 } 3140 # override with our localized language PrintConv if available 3141 my $tmp; 3142 if ($$self{CUR_LANG} and $convType eq 'PrintConv' and 3143 # (no need to check for lang-alt tag names -- they won't have a PrintConv) 3144 ref($tmp = $$self{CUR_LANG}{$$tagInfo{Name}}) eq 'HASH' and 3145 ($tmp = $$tmp{PrintConv})) 3146 { 3147 if ($$conv{BITMASK} and not defined $$conv{$val}) { 3148 my @vals = split ', ', $value; 3149 foreach (@vals) { 3150 $_ = $$tmp{$_} if defined $$tmp{$_}; 3151 } 3152 $value = join ', ', @vals; 3153 } elsif (defined($tmp = $$tmp{$value})) { 3154 $value = $self->Decode($tmp, 'UTF8'); 3155 } 3156 } 3157 } else { 3158 # call subroutine or do eval to convert value 3159 local $SIG{'__WARN__'} = \&SetWarning; 3160 undef $evalWarning; 3161 if (ref $conv eq 'CODE') { 3162 $value = &$conv($val, $self); 3163 } else { 3164 #### eval ValueConv/PrintConv ($val, $self, @val, @prt, @raw) 3165 $value = eval $conv; 3166 $@ and $evalWarning = $@; 3167 } 3168 $self->Warn("$convType $tag: " . CleanWarning()) if $evalWarning; 3169 } 3170 } else { 3171 $value = $val; 3172 } 3173 last unless $vals; 3174 # must store a separate copy of each binary data value in the list 3175 if (ref $value eq 'SCALAR') { 3176 my $tval = $$value; 3177 $value = \$tval; 3178 } 3179 # save this converted value and step to next value in list 3180 push @values, $value if defined $value; 3181 if (++$i >= scalar(@$vals)) { 3182 $value = \@values if @values; 3183 last; 3184 } 3185 $val = $$vals[$i]; 3186 if ($convList) { 3187 my $nextConv = $$convList[$i]; 3188 if ($nextConv and $nextConv eq 'REPEAT') { 3189 undef $convList; 3190 } else { 3191 $conv = $nextConv; 3192 } 3193 } 3194 } 3195 # return undefined now if no value 3196 return () unless defined $value; 3197 # join back into single value if split for conversion list 3198 if ($convList and ref $value eq 'ARRAY') { 3199 $value = join($convType eq 'PrintConv' ? '; ' : ' ', @$value); 3200 } 3201 } 3202 if ($type eq 'Both') { 3203 # save both (unescaped) values because we often need them again 3204 # (Composite tags need "Both" and often Require one tag for various Composite tags) 3205 $$self{BOTH}{$tag} = [ $valueConv, $value ] unless $both; 3206 # escape values if necessary 3207 if ($$self{ESCAPE_PROC}) { 3208 DoEscape($value, $$self{ESCAPE_PROC}); 3209 if (defined $valueConv) { 3210 DoEscape($valueConv, $$self{ESCAPE_PROC}); 3211 } else { 3212 $valueConv = $value; 3213 } 3214 } elsif (not defined $valueConv) { 3215 # $valueConv is undefined if there was no print conversion done 3216 $valueConv = $value; 3217 } 3218 $self->Filter($$self{OPTIONS}{Filter}, \$value); 3219 # return Both values as a list (ValueConv, PrintConv) 3220 return ($valueConv, $value); 3221 } 3222 # escape value if necessary 3223 DoEscape($value, $$self{ESCAPE_PROC}) if $$self{ESCAPE_PROC}; 3224 3225 # filter if necessary 3226 $self->Filter($$self{OPTIONS}{Filter}, \$value) if $$self{OPTIONS}{Filter} and $type eq 'PrintConv'; 3227 3228 if (ref $value eq 'ARRAY') { 3229 if (defined $$self{OPTIONS}{ListItem}) { 3230 $value = $$value[$$self{OPTIONS}{ListItem}]; 3231 } elsif (wantarray) { 3232 # return array if requested 3233 return @$value; 3234 } elsif ($type eq 'PrintConv' and not $$self{OPTIONS}{List} and not ref $$value[0]) { 3235 # join PrintConv values in comma-separated string if List option not used 3236 # and list contains simple scalars (otherwise return ARRAY ref) 3237 $value = join $$self{OPTIONS}{ListSep}, @$value; 3238 } 3239 } 3240 return $value; 3241} 3242 3243#------------------------------------------------------------------------------ 3244# Get tag identification number 3245# Inputs: 0) ExifTool object reference, 1) tag key 3246# Returns: Scalar context: tag ID if available, otherwise '' 3247# List context: 0) tag ID (or ''), 1) language code (or undef) 3248sub GetTagID($$) 3249{ 3250 my ($self, $tag) = @_; 3251 my $tagInfo = $$self{TAG_INFO}{$tag}; 3252 return '' unless $tagInfo and defined $$tagInfo{TagID}; 3253 return ($$tagInfo{TagID}, $$tagInfo{LangCode}) if wantarray; 3254 return $$tagInfo{TagID}; 3255} 3256 3257#------------------------------------------------------------------------------ 3258# Get description for specified tag 3259# Inputs: 0) ExifTool object reference, 1) tag key 3260# Returns: Tag description 3261# Notes: Will always return a defined value, even if description isn't available 3262sub GetDescription($$) 3263{ 3264 local $_; 3265 my ($self, $tag) = @_; 3266 my ($desc, $name); 3267 my $tagInfo = $$self{TAG_INFO}{$tag}; 3268 # ($tagInfo won't be defined for missing tags extracted with -f) 3269 if ($tagInfo) { 3270 # use alternate language description if available 3271 while ($$self{CUR_LANG}) { 3272 $desc = $$self{CUR_LANG}{$$tagInfo{Name}}; 3273 if ($desc) { 3274 # must look up Description if this tag also has a PrintConv 3275 $desc = $$desc{Description} or last if ref $desc; 3276 } else { 3277 # look up default language of lang-alt tag 3278 last unless $$tagInfo{LangCode} and 3279 ($name = $$tagInfo{Name}) =~ s/-$$tagInfo{LangCode}$// and 3280 $desc = $$self{CUR_LANG}{$name}; 3281 $desc = $$desc{Description} or last if ref $desc; 3282 $desc .= " ($$tagInfo{LangCode})"; 3283 } 3284 # escape description if necessary 3285 DoEscape($desc, $$self{ESCAPE_PROC}) if $$self{ESCAPE_PROC}; 3286 # return description in proper Charset 3287 return $self->Decode($desc, 'UTF8'); 3288 } 3289 $desc = $$tagInfo{Description}; 3290 } 3291 # just make the tag more readable if description doesn't exist 3292 unless ($desc) { 3293 $desc = MakeDescription(GetTagName($tag)); 3294 # save description in tag information 3295 $$tagInfo{Description} = $desc if $tagInfo; 3296 } 3297 return $desc; 3298} 3299 3300#------------------------------------------------------------------------------ 3301# Get group name for specified tag 3302# Inputs: 0) ExifTool object reference 3303# 1) tag key (or reference to tagInfo hash, not part of the public API) 3304# 2) [optional] group family (-1 to get extended group list, or multiple 3305# families separated by colons to return multiple groups as a string) 3306# Returns: Scalar context: group name (for family 0 if not otherwise specified) 3307# List context: group name if family specified, otherwise list of 3308# group names for each family. Returns '' for undefined tag. 3309# Notes: Multiple families may be specified with ':' in family argument (eg. '1:2') 3310sub GetGroup($$;$) 3311{ 3312 local $_; 3313 my ($self, $tag, $family) = @_; 3314 my ($tagInfo, @groups, @families, $simplify, $byTagInfo, $ex, $noID); 3315 if (ref $tag eq 'HASH') { 3316 $tagInfo = $tag; 3317 $tag = $$tagInfo{Name}; 3318 # set flag so we don't get extra information for an extracted tag 3319 $byTagInfo = 1; 3320 } else { 3321 $tagInfo = $$self{TAG_INFO}{$tag} || { }; 3322 $ex = $$self{TAG_EXTRA}{$tag}; 3323 } 3324 my $groups = $$tagInfo{Groups}; 3325 # fill in default groups unless already done 3326 # (after this, Groups 0-2 in tagInfo are guaranteed to be defined) 3327 unless ($$tagInfo{GotGroups}) { 3328 my $tagTablePtr = $$tagInfo{Table} || { GROUPS => { } }; 3329 # construct our group list 3330 $groups or $groups = $$tagInfo{Groups} = { }; 3331 # fill in default groups 3332 foreach (0..2) { 3333 $$groups{$_} = $$tagTablePtr{GROUPS}{$_} || '' unless $$groups{$_}; 3334 } 3335 # set flag indicating group list was built 3336 $$tagInfo{GotGroups} = 1; 3337 } 3338 if (defined $family and $family ne '-1') { 3339 if ($family =~ /[^\d]/) { 3340 @families = ($family =~ /\d+/g); 3341 return(($ex && $$ex{G0}) || $$groups{0}) unless @families; 3342 $simplify = 1 unless $family =~ /^:/; 3343 undef $family; 3344 foreach (0..2) { $groups[$_] = $$groups{$_}; } 3345 $noID = 1 if @families == 1 and $families[0] != 7; 3346 } else { 3347 return(($ex && $$ex{"G$family"}) || $$groups{$family}) if $family == 0 or $family == 2; 3348 $groups[1] = $$groups{1}; 3349 } 3350 } else { 3351 return(($ex && $$ex{G0}) || $$groups{0}) unless wantarray; 3352 foreach (0..2) { $groups[$_] = $$groups{$_}; } 3353 } 3354 $groups[3] = 'Main'; 3355 $groups[4] = ($tag =~ /\((\d+)\)$/) ? "Copy$1" : ''; 3356 # handle dynamic group names if necessary 3357 unless ($byTagInfo) { 3358 if ($ex) { 3359 $groups[0] = $$ex{G0} if $$ex{G0}; 3360 $groups[1] = $$ex{G1} =~ /^\+(.*)/ ? "$groups[1]$1" : $$ex{G1} if $$ex{G1}; 3361 $groups[3] = 'Doc' . $$ex{G3} if $$ex{G3}; 3362 $groups[5] = $$ex{G5} || $groups[1] if defined $$ex{G5}; 3363 if (defined $$ex{G6}) { 3364 $groups[5] = '' unless defined $groups[5]; # (can't leave a hole in the array) 3365 $groups[6] = $$ex{G6}; 3366 } 3367 } 3368 # generate tag ID group names unless obviously not needed 3369 unless ($noID) { 3370 my $id = $$tagInfo{TagID}; 3371 if (not defined $id) { 3372 $id = ''; # (just to be safe) 3373 } elsif ($id =~ /^\d+$/) { 3374 $id = sprintf('0x%x', $id) if $$self{OPTIONS}{HexTagIDs}; 3375 } else { 3376 $id =~ s/([^-_A-Za-z0-9])/sprintf('%.2x',ord $1)/ge; 3377 } 3378 $groups[7] = 'ID-' . $id; 3379 defined $groups[$_] or $groups[$_] = '' foreach (5,6); 3380 } 3381 } 3382 if ($family) { 3383 return $groups[$family] || '' if $family > 0; 3384 # add additional matching group names to list 3385 # eg) for MIE-Doc, also add MIE1, MIE1-Doc, MIE-Doc1 and MIE1-Doc1 3386 # and for MIE2-Doc3, also add MIE2, MIE-Doc3, MIE2-Doc and MIE-Doc 3387 if ($groups[1] =~ /^MIE(\d*)-(.+?)(\d*)$/) { 3388 push @groups, 'MIE' . ($1 || '1'); 3389 push @groups, 'MIE' . ($1 ? '' : '1') . "-$2$3"; 3390 push @groups, "MIE$1-$2" . ($3 ? '' : '1'); 3391 push @groups, 'MIE' . ($1 ? '' : '1') . "-$2" . ($3 ? '' : '1'); 3392 } 3393 } 3394 if (@families) { 3395 my @grps; 3396 # create list of group names (without identical adjacent groups if simplifying) 3397 foreach (@families) { 3398 my $grp = $groups[$_]; 3399 unless ($grp) { 3400 next if $simplify; 3401 $grp = ''; 3402 } 3403 push @grps, $grp unless $simplify and @grps and $grp eq $grps[-1]; 3404 } 3405 # remove leading "Main:" if simplifying 3406 shift @grps if $simplify and @grps > 1 and $grps[0] eq 'Main'; 3407 # return colon-separated string of group names 3408 return join ':', @grps; 3409 } 3410 return @groups; 3411} 3412 3413#------------------------------------------------------------------------------ 3414# Get group names for specified tags 3415# Inputs: 0) ExifTool object reference 3416# 1) [optional] information hash reference (default all extracted info) 3417# 2) [optional] group family (default 0) 3418# Returns: List of group names in alphabetical order 3419sub GetGroups($;$$) 3420{ 3421 local $_; 3422 my $self = shift; 3423 my $info = shift; 3424 my $family; 3425 3426 # figure out our arguments 3427 if (ref $info ne 'HASH') { 3428 $family = $info; 3429 $info = $$self{VALUE}; 3430 } else { 3431 $family = shift; 3432 } 3433 $family = 0 unless defined $family; 3434 3435 # get a list of all groups in specified information 3436 my ($tag, %groups); 3437 foreach $tag (keys %$info) { 3438 $groups{ $self->GetGroup($tag, $family) } = 1; 3439 } 3440 return sort keys %groups; 3441} 3442 3443#------------------------------------------------------------------------------ 3444# Set priority for group where new values are written 3445# Inputs: 0) ExifTool object reference, 3446# 1-N) group names (reset to default if no groups specified) 3447# - used when new tag values are set (ie. before files are written) 3448sub SetNewGroups($;@) 3449{ 3450 local $_; 3451 my ($self, @groups) = @_; 3452 @groups or @groups = @defaultWriteGroups; 3453 my $count = @groups * 10; 3454 my %priority; 3455 foreach (@groups) { 3456 $priority{lc($_)} = $count; 3457 $count -= 10; 3458 } 3459 $priority{file} = 500; # 'File' group is always written (Comment) 3460 $priority{composite} = 500; # 'Composite' group is always written 3461 # set write priority (higher # is higher priority) 3462 $$self{WRITE_PRIORITY} = \%priority; 3463 $$self{WRITE_GROUPS} = \@groups; 3464} 3465 3466#------------------------------------------------------------------------------ 3467# Build Composite tags from Require'd/Desire'd tags 3468# Inputs: 0) ExifTool object reference 3469# Note: Tag values are calculated in alphabetical order unless a tag Require's 3470# or Desire's another Composite tag, in which case the calculation is 3471# deferred until after the other tag is calculated. 3472sub BuildCompositeTags($) 3473{ 3474 local $_; 3475 my $self = shift; 3476 3477 $$self{BuildingComposite} = 1; 3478 3479 my $compTable = GetTagTable('Image::ExifTool::Composite'); 3480 my @tagList = sort keys %$compTable; 3481 my $rawValue = $$self{VALUE}; 3482 my $compKeys = $$self{COMP_KEYS}; 3483 my (%cache, $allBuilt); 3484 3485 for (;;) { 3486 my (%notBuilt, $tag, @deferredTags); 3487 foreach (@tagList) { 3488 $notBuilt{$$compTable{$_}{Name}} = 1 unless $specialTags{$_}; 3489 } 3490COMPOSITE_TAG: 3491 foreach $tag (@tagList) { 3492 next if $specialTags{$tag}; 3493 my $tagInfo = $self->GetTagInfo($compTable, $tag); 3494 next unless $tagInfo; 3495 my $tagName = $$compTable{$tag}{Name}; 3496 # put required tags into array and make sure they all exist 3497 my $subDoc = ($$tagInfo{SubDoc} and $$self{DOC_COUNT}); 3498 my $require = $$tagInfo{Require} || { }; 3499 my $desire = $$tagInfo{Desire} || { }; 3500 my $inhibit = $$tagInfo{Inhibit} || { }; 3501 # loop through sub-documents if necessary 3502 my $docNum = 0; 3503 for (;;) { 3504 my (%tagKey, $found, $index); 3505 # save Require'd and Desire'd tag values in list 3506 for ($index=0; ; ++$index) { 3507 my $reqTag = $$require{$index} || $$desire{$index} || $$inhibit{$index}; 3508 unless ($reqTag) { 3509 # allow Composite with no Require'd or Desire'd tags 3510 $found = 1 if $index == 0; 3511 last; 3512 } 3513 if ($subDoc) { 3514 # handle SubDoc tags specially to cache tag keys for faster 3515 # processing when there are a large number of sub-documents 3516 # - get document number from the tag groups if specified, 3517 # otherwise we are looping through all documents for this tag 3518 my $doc = $reqTag =~ s/\b(Main|Doc(\d+)):// ? ($2 || 0) : $docNum; 3519 # make fast lookup for keys of this tag with specified groups other than doc group 3520 # (similar to code in InsertTagValues(), but this is case-sensitive) 3521 my $cacheTag = $cache{$reqTag}; 3522 unless ($cacheTag) { 3523 $cacheTag = $cache{$reqTag} = [ ]; 3524 my $reqGroup; 3525 $reqTag =~ s/^(.*):// and $reqGroup = $1; 3526 my ($i, $key, @keys); 3527 # build list of tag keys in order of precedence 3528 for ($key=$reqTag, $i=$$self{DUPL_TAG}{$reqTag} || 0; ; --$i) { 3529 push @keys, $key if defined $$rawValue{$key}; 3530 last if $i <= 0; 3531 $key = "$reqTag ($i)"; 3532 } 3533 @keys = $self->GroupMatches($reqGroup, \@keys) if defined $reqGroup; 3534 if (@keys) { 3535 my $ex = $$self{TAG_EXTRA}; 3536 # loop through tags in reverse order of precedence so the higher 3537 # priority tag will win in the case of duplicates within a doc 3538 $$cacheTag[$$ex{$_} ? $$ex{$_}{G3} || 0 : 0] = $_ foreach reverse @keys; 3539 } 3540 } 3541 # (set $reqTag to a bogus key if not found) 3542 $reqTag = $$cacheTag[$doc] || "$reqTag (0)"; 3543 } elsif ($reqTag =~ /^(.*):(.+)/) { 3544 my ($reqGroup, $name) = ($1, $2); 3545 if ($reqGroup eq 'Composite' and $notBuilt{$name}) { 3546 # defer only until all other tags are built if 3547 # we are inhibiting based on another Composite tag 3548 unless ($$inhibit{$index} and $allBuilt) { 3549 push @deferredTags, $tag; 3550 next COMPOSITE_TAG; 3551 } 3552 } 3553 # (CAREFUL! keys may not be sequential if one was deleted) 3554 my ($i, $key, @keys); 3555 for ($key=$name, $i=$$self{DUPL_TAG}{$name} || 0; ; --$i) { 3556 push @keys, $key if defined $$rawValue{$key}; 3557 last if $i <= 0; 3558 $key = "$name ($i)"; 3559 } 3560 # find first matching tag 3561 $key = $self->GroupMatches($reqGroup, \@keys); 3562 $reqTag = $key || "$name (0)"; 3563 } elsif ($notBuilt{$reqTag} and not $$inhibit{$index}) { 3564 # calculate this tag later if it relies on another 3565 # Composite tag which hasn't been calculated yet 3566 push @deferredTags, $tag; 3567 next COMPOSITE_TAG; 3568 } 3569 if (defined $$rawValue{$reqTag}) { 3570 if ($$inhibit{$index}) { 3571 $found = 0; 3572 last; 3573 } else { 3574 $found = 1; 3575 } 3576 } elsif ($$require{$index}) { 3577 $found = 0; 3578 last; # don't continue since we require this tag 3579 } 3580 $tagKey{$index} = $reqTag; 3581 } 3582 if ($docNum) { 3583 if ($found) { 3584 $$self{DOC_NUM} = $docNum; 3585 # save pointers to all used tag keys 3586 foreach (keys %tagKey) { 3587 $$compKeys{$_} or $$compKeys{$_} = [ ]; 3588 push @{$$compKeys{$tagKey{$_}}}, [ \%tagKey, $_ ]; 3589 } 3590 $self->FoundTag($tagInfo, \%tagKey); 3591 delete $$self{DOC_NUM}; 3592 } 3593 next if ++$docNum <= $$self{DOC_COUNT}; 3594 last; 3595 } elsif ($found) { 3596 delete $notBuilt{$tagName}; # this tag is OK to build now 3597 # keep track of all Require'd tag keys 3598 foreach (keys %tagKey) { 3599 # only tag keys with same name as a Composite tag 3600 # can be replaced (also eliminates keys with 3601 # instance numbers which can't be replaced either) 3602 next unless $compositeID{$tagKey{$_}}; 3603 } 3604 # save pointers to all used tag keys 3605 foreach (keys %tagKey) { 3606 $$compKeys{$_} or $$compKeys{$_} = [ ]; 3607 push @{$$compKeys{$tagKey{$_}}}, [ \%tagKey, $_ ]; 3608 } 3609 # save reference to tag key lookup as value for Composite tag 3610 my $key = $self->FoundTag($tagInfo, \%tagKey); 3611 } elsif (not defined $found) { 3612 delete $notBuilt{$tagName}; # tag can't be built anyway 3613 } 3614 last unless $subDoc; 3615 # don't process sub-documents if there is no chance to build this tag 3616 # (can be very time-consuming if there are many docs) 3617 if (%$require) { 3618 foreach (keys %$require) { 3619 my $reqTag = $$require{$_}; 3620 $reqTag =~ s/.*://; 3621 next COMPOSITE_TAG unless defined $$rawValue{$reqTag}; 3622 } 3623 $docNum = 1; # go ahead and process the 1st sub-document 3624 } else { 3625 my @try = ref $$tagInfo{SubDoc} ? @{$$tagInfo{SubDoc}} : keys %$desire; 3626 # at least one of the specified desire tags must exist 3627 foreach (@try) { 3628 my $desTag = $$desire{$_} or next; 3629 $desTag =~ s/.*://; 3630 defined $$rawValue{$desTag} and $docNum = 1, last; 3631 } 3632 last unless $docNum; 3633 } 3634 } 3635 } 3636 last unless @deferredTags; 3637 if (@deferredTags == @tagList) { 3638 if ($allBuilt) { 3639 # everything was deferred in the last pass, 3640 # must be a circular dependency 3641 warn "Circular dependency in Composite tags\n"; 3642 last; 3643 } 3644 $allBuilt = 1; # try once more, ignoring Composite Inhibit tags 3645 } 3646 @tagList = @deferredTags; # calculate deferred tags now 3647 } 3648 delete $$self{BuildingComposite}; 3649} 3650 3651#------------------------------------------------------------------------------ 3652# Get reference to Composite tag info hash 3653# Inputs: 0) case-sensitive Composite tag name 3654# Returns: tagInfo hash or undef 3655sub GetCompositeTagInfo($) 3656{ 3657 my $tag = shift; 3658 return undef unless $compositeID{$tag}; 3659 return $Image::ExifTool::Composite{$compositeID{$tag}[0]}; 3660} 3661 3662#------------------------------------------------------------------------------ 3663# Get tag name (removes copy index) 3664# Inputs: 0) Tag key 3665# Returns: Tag name 3666sub GetTagName($) 3667{ 3668 local $_; 3669 $_[0] =~ /^(\S+)/; 3670 return $1; 3671} 3672 3673#------------------------------------------------------------------------------ 3674# Get list of shortcuts 3675# Returns: Shortcut list (sorted alphabetically) 3676sub GetShortcuts() 3677{ 3678 local $_; 3679 require Image::ExifTool::Shortcuts; 3680 return sort keys %Image::ExifTool::Shortcuts::Main; 3681} 3682 3683#------------------------------------------------------------------------------ 3684# Get file type for specified extension 3685# Inputs: 0) file name or extension (case is not significant), 3686# or FileType value if a description is requested 3687# 1) flag to return long description instead of type ('0' to return any recognized type) 3688# Returns: File type (or desc) or undef if extension not supported or if 3689# description is the same as the input FileType. In list context, 3690# may return more than one file type if the file may be different formats. 3691# Returns list of all supported extensions if no file specified 3692sub GetFileType(;$$) 3693{ 3694 local $_; 3695 my ($file, $desc) = @_; 3696 unless (defined $file) { 3697 my @types; 3698 if (defined $desc and $desc eq '0') { 3699 # return all recognized types 3700 @types = sort keys %fileTypeLookup; 3701 } else { 3702 # return all supported types 3703 foreach (sort keys %fileTypeLookup) { 3704 my $module = $moduleName{$_}; 3705 $module = $moduleName{$fileTypeLookup{$_}} unless defined $module; 3706 push @types, $_ unless defined $module and $module eq '0'; 3707 } 3708 } 3709 return @types; 3710 } 3711 my ($fileType, $subType); 3712 my $fileExt = GetFileExtension($file); 3713 unless ($fileExt) { 3714 if ($file =~ s/ \((.*)\)$//) { 3715 $subType = $1; 3716 $fileExt = GetFileExtension($file); 3717 } 3718 $fileExt = uc($file) unless $fileExt; 3719 } 3720 $fileExt and $fileType = $fileTypeLookup{$fileExt}; # look up the file type 3721 $fileType = $fileTypeLookup{$fileType} while $fileType and not ref $fileType; 3722 # return description if specified 3723 # (allow input $file to be a FileType for this purpose) 3724 if ($desc) { 3725 $desc = $fileType ? $$fileType[1] : $fileDescription{$file}; 3726 $desc .= ", $subType" if $subType; 3727 return $desc; 3728 } elsif ($fileType and (not defined $desc or $desc ne '0')) { 3729 # return only supported file types 3730 my $mod = $moduleName{$$fileType[0]}; 3731 undef $fileType if defined $mod and $mod eq '0'; 3732 } 3733 $fileType or return (); 3734 $fileType = $$fileType[0]; # get file type (or list of types) 3735 if (wantarray) { 3736 return @$fileType if ref $fileType eq 'ARRAY'; 3737 } elsif ($fileType) { 3738 $fileType = $fileExt if ref $fileType eq 'ARRAY'; 3739 } 3740 return $fileType; 3741} 3742 3743#------------------------------------------------------------------------------ 3744# Return true if we can write the specified file type 3745# Inputs: 0) file name or ext 3746# Returns: true if writable, 0 if not writable, undef if unrecognized 3747sub CanWrite($) 3748{ 3749 local $_; 3750 my $file = shift or return undef; 3751 my ($type) = GetFileType($file) or return undef; 3752 if ($noWriteFile{$type}) { 3753 # can't write TIFF files with certain extensions (various RAW formats) 3754 my $ext = GetFileExtension($file) || uc($file); 3755 return grep(/^$ext$/, @{$noWriteFile{$type}}) ? 0 : 1 if $ext; 3756 } 3757 unless (%writeTypes) { 3758 $writeTypes{$_} = 1 foreach @writeTypes; 3759 } 3760 return $writeTypes{$type}; 3761} 3762 3763#------------------------------------------------------------------------------ 3764# Return true if we can create the specified file type 3765# Inputs: 0) file name or ext 3766# Returns: true if creatable, 0 if not writable, undef if unrecognized 3767sub CanCreate($) 3768{ 3769 local $_; 3770 my $file = shift or return undef; 3771 my $ext = GetFileExtension($file) || uc($file); 3772 my $type = GetFileType($file) or return undef; 3773 return 1 if $createTypes{$ext} or $createTypes{$type}; 3774 return 0; 3775} 3776 3777#============================================================================== 3778# Functions below this are not part of the public API 3779 3780# Initialize member variables for reading or writing a new file 3781# Inputs: 0) ExifTool object reference 3782sub Init($) 3783{ 3784 local $_; 3785 my $self = shift; 3786 # delete all DataMember variables (lower-case names) 3787 foreach (keys %$self) { 3788 /[a-z]/ and delete $$self{$_}; 3789 } 3790 delete $$self{FOUND_TAGS}; # list of found tags 3791 delete $$self{EXIF_DATA}; # the EXIF data block 3792 delete $$self{EXIF_POS}; # EXIF position in file 3793 delete $$self{FIRST_EXIF_POS}; # position of first EXIF in file 3794 delete $$self{HTML_DUMP}; # html dump information 3795 delete $$self{SET_GROUP0}; # group0 name override 3796 delete $$self{SET_GROUP1}; # group1 name override 3797 delete $$self{DOC_NUM}; # current embedded document number 3798 $$self{DOC_COUNT} = 0; # count of embedded documents processed 3799 $$self{BASE} = 0; # base for offsets from start of file 3800 $$self{FILE_ORDER} = { }; # * hash of tag order in file ('*' = based on tag key) 3801 $$self{VALUE} = { }; # * hash of raw tag values 3802 $$self{BOTH} = { }; # * hash for Value/PrintConv values of Require'd tags 3803 $$self{RATIONAL} = { }; # * hash of original rational components 3804 $$self{TAG_INFO} = { }; # * hash of tag information 3805 $$self{TAG_EXTRA} = { }; # * hash of extra tag information (dynamic group names) 3806 $$self{PRIORITY} = { }; # * priority of current tags 3807 $$self{LIST_TAGS} = { }; # hash of tagInfo refs for active List-type tags 3808 $$self{PROCESSED} = { }; # hash of processed directory start positions 3809 $$self{DIR_COUNT} = { }; # count various types of directories 3810 $$self{DUPL_TAG} = { }; # last-used index for duplicate-tag keys 3811 $$self{WARNED_ONCE}= { }; # WarnOnce() warnings already issued 3812 $$self{WRITTEN} = { }; # list of tags written (selected tags only) 3813 $$self{FORCE_WRITE}= { }; # ForceWrite lookup (set from ForceWrite tag) 3814 $$self{FOUND_DIR} = { }; # hash of directory names found in file 3815 $$self{COMP_KEYS} = { }; # lookup for tag keys used in Composite tags 3816 $$self{PATH} = [ ]; # current subdirectory path in file when reading 3817 $$self{NUM_FOUND} = 0; # total number of tags found (incl. duplicates) 3818 $$self{CHANGED} = 0; # number of tags changed (writer only) 3819 $$self{INDENT} = ' '; # initial indent for verbose messages 3820 $$self{PRIORITY_DIR} = ''; # the priority directory name 3821 $$self{LOW_PRIORITY_DIR} = { PreviewIFD => 1 }; # names of priority 0 directories 3822 $$self{TIFF_TYPE} = ''; # type of TIFF data (APP1, TIFF, NEF, etc...) 3823 $$self{FMT_EXPR} = undef; # current advanced formatting expression 3824 $$self{Make} = ''; # camera make 3825 $$self{Model} = ''; # camera model 3826 $$self{CameraType} = ''; # Olympus camera type 3827 $$self{FileType} = ''; # identified file type 3828 if ($self->Options('HtmlDump')) { 3829 require Image::ExifTool::HtmlDump; 3830 $$self{HTML_DUMP} = new Image::ExifTool::HtmlDump; 3831 } 3832 # make sure our TextOut is a file reference 3833 $$self{OPTIONS}{TextOut} = \*STDOUT unless ref $$self{OPTIONS}{TextOut}; 3834} 3835 3836#------------------------------------------------------------------------------ 3837# Combine information from a list of info hashes 3838# Unless Duplicates is enabled, first entry found takes priority 3839# Inputs: 0) ExifTool object reference, 1-N) list of info hash references 3840# Returns: Combined information hash reference 3841sub CombineInfo($;@) 3842{ 3843 local $_; 3844 my $self = shift; 3845 my (%combinedInfo, $info, $tag, %haveInfo); 3846 3847 if ($$self{OPTIONS}{Duplicates}) { 3848 while ($info = shift) { 3849 foreach $tag (keys %$info) { 3850 $combinedInfo{$tag} = $$info{$tag}; 3851 } 3852 } 3853 } else { 3854 while ($info = shift) { 3855 foreach $tag (keys %$info) { 3856 my $tagName = GetTagName($tag); 3857 next if $haveInfo{$tagName}; 3858 $haveInfo{$tagName} = 1; 3859 $combinedInfo{$tag} = $$info{$tag}; 3860 } 3861 } 3862 } 3863 return \%combinedInfo; 3864} 3865 3866#------------------------------------------------------------------------------ 3867# Get tag table name 3868# Inputs: 0) ExifTool object reference, 1) tag key 3869# Returns: Table name if available, otherwise '' 3870sub GetTableName($$) 3871{ 3872 my ($self, $tag) = @_; 3873 my $tagInfo = $$self{TAG_INFO}{$tag} or return ''; 3874 return $$tagInfo{Table}{SHORT_NAME}; 3875} 3876 3877#------------------------------------------------------------------------------ 3878# Get tag index number 3879# Inputs: 0) ExifTool object reference, 1) tag key 3880# Returns: Table index number, or undefined if this tag isn't indexed 3881sub GetTagIndex($$) 3882{ 3883 my ($self, $tag) = @_; 3884 my $tagInfo = $$self{TAG_INFO}{$tag} or return undef; 3885 return $$tagInfo{Index}; 3886} 3887 3888#------------------------------------------------------------------------------ 3889# Find value for specified tag 3890# Inputs: 0) ExifTool ref, 1) tag name, 2) tag group (family 1) 3891# Returns: value or undef 3892sub FindValue($$$) 3893{ 3894 my ($et, $tag, $grp) = @_; 3895 my ($i, $val); 3896 my $value = $$et{VALUE}; 3897 for ($i=0; ; ++$i) { 3898 my $key = $tag . ($i ? " ($i)" : ''); 3899 last unless defined $$value{$key}; 3900 if ($et->GetGroup($key, 1) eq $grp) { 3901 $val = $$value{$key}; 3902 last; 3903 } 3904 } 3905 return $val; 3906} 3907 3908#------------------------------------------------------------------------------ 3909# Get tag key for next existing tag 3910# Inputs: 0) ExifTool ref, 1) tag key or case-sensitive tag name 3911# Returns: Key of next existing tag, or undef if no more 3912# Notes: This routine is provided for iterating through duplicate tags in the 3913# ValueConv of Composite tags. 3914sub NextTagKey($$) 3915{ 3916 my ($self, $tag) = @_; 3917 my $i = ($tag =~ s/ \((\d+)\)$//) ? $1 + 1 : 1; 3918 $tag = "$tag ($i)"; 3919 return $tag if defined $$self{VALUE}{$tag}; 3920 return undef; 3921} 3922 3923#------------------------------------------------------------------------------ 3924# Split file name into directory and name parts 3925# Inptus: 0) file name 3926# Returns: 0) directory, 1) filename 3927sub SplitFileName($) 3928{ 3929 my $file = shift; 3930 my ($dir, $name); 3931 if (eval { require File::Basename }) { 3932 $dir = File::Basename::dirname($file); 3933 $name = File::Basename::basename($file); 3934 } else { 3935 ($name = $file) =~ tr/\\/\//; 3936 # remove path 3937 $dir = length($1) ? $1 : '/' if $name =~ s/(.*)\///; 3938 } 3939 return ($dir, $name); 3940} 3941 3942#------------------------------------------------------------------------------ 3943# Encode file name for calls to system i/o routines 3944# Inputs: 0) ExifTool ref, 1) file name in CharSetFileName, 2) flag to force conversion 3945# Returns: true if Windows Unicode routines should be used (in which case 3946# the file name will be encoded as a null-terminated UTF-16LE string) 3947sub EncodeFileName($$;$) 3948{ 3949 my ($self, $file, $force) = @_; 3950 my $enc = $$self{OPTIONS}{CharsetFileName}; 3951 if ($enc) { 3952 if ($file =~ /[\x80-\xff]/ or $force) { 3953 # encode for use in Windows Unicode functions if necessary 3954 if ($^O eq 'MSWin32') { 3955 local $SIG{'__WARN__'} = \&SetWarning; 3956 if (eval { require Win32API::File }) { 3957 # recode as UTF-16LE and add null terminator 3958 $_[1] = $self->Decode($file, $enc, undef, 'UTF16', 'II') . "\0\0"; 3959 return 1; 3960 } 3961 $self->WarnOnce('Install Win32API::File for Windows Unicode file support'); 3962 } else { 3963 # recode as UTF-8 for other platforms if necessary 3964 $_[1] = $self->Decode($file, $enc, undef, 'UTF8') unless $enc eq 'UTF8'; 3965 } 3966 } 3967 } elsif ($^O eq 'MSWin32' and $file =~ /[\x80-\xff]/ and not defined $enc) { 3968 require Image::ExifTool::XMP; 3969 if (Image::ExifTool::XMP::IsUTF8(\$file) < 0) { 3970 $self->WarnOnce('FileName encoding not specified'); 3971 } 3972 } 3973 return 0; 3974} 3975 3976#------------------------------------------------------------------------------ 3977# Modified perl open() routine to properly handle special characters in file names 3978# Inputs: 0) ExifTool ref, 1) filehandle, 2) filename, 3979# 3) mode: '<' or undef = read, '>' = write, '+<' = update 3980# Returns: true on success 3981# Note: Must call like "$et->Open(\*FH,$file)", not "$et->Open(FH,$file)" to avoid 3982# "unopened filehandle" errors due to a change in scope of the filehandle 3983sub Open($*$;$) 3984{ 3985 my ($self, $fh, $file, $mode) = @_; 3986 3987 $file =~ s/^([\s&])/.\/$1/; # protect leading whitespace or ampersand 3988 # default to read mode ('<') unless input is a pipe 3989 $mode = ($file =~ /\|$/ ? '' : '<') unless $mode; 3990 if ($mode) { 3991 if ($self->EncodeFileName($file)) { 3992 # handle Windows Unicode file name 3993 local $SIG{'__WARN__'} = \&SetWarning; 3994 my ($access, $create); 3995 if ($mode eq '>') { 3996 eval { 3997 $access = Win32API::File::GENERIC_WRITE(); 3998 $create = Win32API::File::CREATE_ALWAYS(); 3999 } 4000 } else { 4001 eval { 4002 $access = Win32API::File::GENERIC_READ(); 4003 $access |= Win32API::File::GENERIC_WRITE() if $mode eq '+<'; # update 4004 $create = Win32API::File::OPEN_EXISTING(); 4005 } 4006 } 4007 my $share = 0; 4008 eval { 4009 unless ($access & Win32API::File::GENERIC_WRITE()) { 4010 $share = Win32API::File::FILE_SHARE_READ() | Win32API::File::FILE_SHARE_WRITE(); 4011 } 4012 }; 4013 my $wh = eval { Win32API::File::CreateFileW($file, $access, $share, [], $create, 0, []) }; 4014 return undef unless $wh; 4015 my $fd = eval { Win32API::File::OsFHandleOpenFd($wh, 0) }; 4016 if (not defined $fd or $fd < 0) { 4017 eval { Win32API::File::CloseHandle($wh) }; 4018 return undef; 4019 } 4020 $file = "&=$fd"; # specify file by descriptor 4021 } else { 4022 # add leading space to protect against leading characters like '>' 4023 # in file name, and trailing "\0" to protect trailing spaces 4024 $file = " $file\0"; 4025 } 4026 } 4027 return open $fh, "$mode$file"; 4028} 4029 4030#------------------------------------------------------------------------------ 4031# Check to see if a file exists (with Windows Unicode support) 4032# Inputs: 0) ExifTool ref, 1) file name 4033# Returns: true if file exists 4034sub Exists($$) 4035{ 4036 my ($self, $file) = @_; 4037 4038 if ($self->EncodeFileName($file)) { 4039 local $SIG{'__WARN__'} = \&SetWarning; 4040 my $wh = eval { Win32API::File::CreateFileW($file, 4041 Win32API::File::GENERIC_READ(), 4042 Win32API::File::FILE_SHARE_READ(), [], 4043 Win32API::File::OPEN_EXISTING(), 0, []) }; 4044 return 0 unless $wh; 4045 eval { Win32API::File::CloseHandle($wh) }; 4046 } else { 4047 return -e $file; 4048 } 4049 return 1; 4050} 4051 4052#------------------------------------------------------------------------------ 4053# Return true if file is a directory (with Windows Unicode support) 4054# Inputs: 0) ExifTool ref, 1) file name 4055# Returns: true if file is a directory (false if file isn't, or doesn't exist) 4056sub IsDirectory($$) 4057{ 4058 my ($et, $file) = @_; 4059 if ($et->EncodeFileName($file)) { 4060 local $SIG{'__WARN__'} = \&SetWarning; 4061 my $attrs = eval { Win32API::File::GetFileAttributesW($file) }; 4062 my $dirBit = eval { Win32API::File::FILE_ATTRIBUTE_DIRECTORY() } || 0; 4063 return 1 if $attrs and $attrs != 0xffffffff and $attrs & $dirBit; 4064 } else { 4065 return -d $file; 4066 } 4067 return 0; 4068} 4069 4070#------------------------------------------------------------------------------ 4071# Get file times (Unix seconds since the epoch) 4072# Inputs: 0) ExifTool ref, 1) file name or ref 4073# Returns: 0) access time, 1) modification time, 2) creation time (or undefs on error) 4074my $k32GetFileTime; 4075sub GetFileTime($$) 4076{ 4077 my ($self, $file) = @_; 4078 4079 # open file by name if necessary 4080 unless (ref $file) { 4081 local *FH; 4082 $self->Open(\*FH, $file) or $self->Warn("GetFileTime error for '${file}'"), return (); 4083 $file = *FH; # (not \*FH, so *FH will be kept open until $file goes out of scope) 4084 } 4085 # on Windows, try to work around incorrect file times when daylight saving time is in effect 4086 if ($^O eq 'MSWin32') { 4087 if (not eval { require Win32::API }) { 4088 $self->WarnOnce('Install Win32::API for proper handling of Windows file times'); 4089 } elsif (not eval { require Win32API::File }) { 4090 $self->WarnOnce('Install Win32API::File for proper handling of Windows file times'); 4091 } else { 4092 # get Win32 handle, needed for GetFileTime 4093 my $win32Handle = eval { Win32API::File::GetOsFHandle($file) }; 4094 unless ($win32Handle) { 4095 $self->Warn("Win32API::File::GetOsFHandle returned invalid handle"); 4096 return (); 4097 } 4098 # get FILETIME structs 4099 my ($atime, $mtime, $ctime, $time); 4100 $atime = $mtime = $ctime = pack 'LL', 0, 0; 4101 unless ($k32GetFileTime) { 4102 return () if defined $k32GetFileTime; 4103 $k32GetFileTime = new Win32::API('KERNEL32', 'GetFileTime', 'NPPP', 'I'); 4104 unless ($k32GetFileTime) { 4105 $self->Warn('Error calling Win32::API::GetFileTime'); 4106 $k32GetFileTime = 0; 4107 return (); 4108 } 4109 } 4110 unless ($k32GetFileTime->Call($win32Handle, $ctime, $atime, $mtime)) { 4111 $self->Warn("Win32::API::GetFileTime returned " . Win32::GetLastError()); 4112 return (); 4113 } 4114 # convert FILETIME structs to Unix seconds 4115 foreach $time ($atime, $mtime, $ctime) { 4116 my ($lo, $hi) = unpack 'LL', $time; # unpack FILETIME struct 4117 # FILETIME is in 100 ns intervals since 0:00 UTC Jan 1, 1601 4118 # (89 leap years between 1601 and 1970) 4119 $time = ($hi * 4294967296 + $lo) * 1e-7 - (((1970-1601)*365+89)*24*3600); 4120 } 4121 return ($atime, $mtime, $ctime); 4122 } 4123 } 4124 # other os (or Windows fallback) 4125 return (stat $file)[8, 9, 10]; 4126} 4127 4128#------------------------------------------------------------------------------ 4129# Parse function arguments and set member variables accordingly 4130# Inputs: Same as ImageInfo() 4131# - sets REQUESTED_TAGS, REQ_TAG_LOOKUP, IO_TAG_LIST, FILENAME, RAF, OPTIONS 4132sub ParseArguments($;@) 4133{ 4134 my $self = shift; 4135 my $options = $$self{OPTIONS}; 4136 my @oldGroupOpts = grep /^Group/, keys %{$$self{OPTIONS}}; 4137 my (@exclude, $wasExcludeOpt); 4138 4139 $$self{REQUESTED_TAGS} = [ ]; 4140 $$self{REQ_TAG_LOOKUP} = { }; 4141 $$self{EXCL_TAG_LOOKUP} = { }; 4142 $$self{IO_TAG_LIST} = undef; 4143 4144 # handle our input arguments 4145 while (@_) { 4146 my $arg = shift; 4147 if (ref $arg and not overload::Method($arg, q[""])) { 4148 if (ref $arg eq 'ARRAY') { 4149 $$self{IO_TAG_LIST} = $arg; 4150 foreach (@$arg) { 4151 if (/^-(.*)/) { 4152 push @exclude, $1; 4153 } else { 4154 push @{$$self{REQUESTED_TAGS}}, $_; 4155 } 4156 } 4157 } elsif (ref $arg eq 'HASH') { 4158 my $opt; 4159 foreach $opt (keys %$arg) { 4160 # a single new group option overrides all old group options 4161 if (@oldGroupOpts and $opt =~ /^Group/) { 4162 foreach (@oldGroupOpts) { 4163 delete $$options{$_}; 4164 } 4165 undef @oldGroupOpts; 4166 } 4167 $self->Options($opt, $$arg{$opt}); 4168 $opt eq 'Exclude' and $wasExcludeOpt = 1; 4169 } 4170 } elsif (ref $arg eq 'SCALAR' or UNIVERSAL::isa($arg,'GLOB')) { 4171 next if defined $$self{RAF}; 4172 # convert image data from UTF-8 to character stream if necessary 4173 # (patches RHEL 3 UTF8 LANG problem) 4174 if (ref $arg eq 'SCALAR' and $] >= 5.006 and 4175 (eval { require Encode; Encode::is_utf8($$arg) } or $@)) 4176 { 4177 # repack by hand if Encode isn't available 4178 my $buff = $@ ? pack('C*',unpack($] < 5.010000 ? 'U0C*' : 'C0C*',$$arg)) : Encode::encode('utf8',$$arg); 4179 $arg = \$buff; 4180 } 4181 $$self{RAF} = new File::RandomAccess($arg); 4182 # set filename to empty string to indicate that 4183 # we have a file but we didn't open it 4184 $$self{FILENAME} = ''; 4185 } elsif (UNIVERSAL::isa($arg, 'File::RandomAccess')) { 4186 $$self{RAF} = $arg; 4187 $$self{FILENAME} = ''; 4188 } else { 4189 warn "Don't understand ImageInfo argument $arg\n"; 4190 } 4191 } elsif (defined $$self{FILENAME}) { 4192 if ($arg =~ /^-(.*)/) { 4193 push @exclude, $1; 4194 } else { 4195 push @{$$self{REQUESTED_TAGS}}, $arg; 4196 } 4197 } else { 4198 $$self{FILENAME} = $arg; 4199 } 4200 } 4201 # add additional requested tags to lookup 4202 if ($$options{RequestTags}) { 4203 $$self{REQ_TAG_LOOKUP}{$_} = 1 foreach @{$$options{RequestTags}}; 4204 } 4205 # expand shortcuts in tag arguments if provided 4206 if (@{$$self{REQUESTED_TAGS}}) { 4207 ExpandShortcuts($$self{REQUESTED_TAGS}); 4208 # initialize lookup for requested tags 4209 foreach (@{$$self{REQUESTED_TAGS}}) { 4210 /^(.*:)?([-\w?*]*)#?$/ or next; 4211 $$self{REQ_TAG_LOOKUP}{lc($2)} = 1 if $2; 4212 next unless $1; 4213 $$self{REQ_TAG_LOOKUP}{lc($_).':'} = 1 foreach split /:/, $1; 4214 } 4215 } 4216 if (@exclude or $wasExcludeOpt) { 4217 # must add existing excluded tags 4218 push @exclude, @{$$options{Exclude}} if $$options{Exclude}; 4219 $$options{Exclude} = \@exclude; 4220 # expand shortcuts in new exclude list 4221 ExpandShortcuts($$options{Exclude}, 1); # (also remove '#' suffix) 4222 } 4223 # generate lookup for excluded tags 4224 if ($$options{Exclude}) { 4225 foreach (@{$$options{Exclude}}) { 4226 /([-\w]+)#?$/ and $$self{EXCL_TAG_LOOKUP}{lc($1)} = 1; 4227 } 4228 # exclude list is used only for EXCL_TAG_LOOKUP when TAGS_FROM_FILE is set 4229 undef $$options{Exclude} if $$self{TAGS_FROM_FILE}; 4230 } 4231} 4232 4233#------------------------------------------------------------------------------ 4234# Does group name match the tag ID? 4235# Inputs: 0) tag ID, 1) group name (with "ID-" removed) 4236# Returns: true on success 4237sub IsSameID($$) 4238{ 4239 my ($id, $grp) = @_; 4240 return 1 if $grp eq $id; # decimal ID's or raw ID's 4241 if ($id =~ /^\d+$/) { # numerical numerical ID's may be in hex 4242 return 1 if $grp =~ s/^0x0*// and $grp eq sprintf('%x', $id); 4243 } else { # other ID's may conform to ExifTool group name conventions 4244 return 1 if $id =~ s/([^-_A-Za-z0-9])/sprintf('%.2x',ord $1)/ge and $grp eq $id; 4245 } 4246 return 0; 4247} 4248 4249#------------------------------------------------------------------------------ 4250# Get list of tags in specified group 4251# Inputs: 0) ExifTool ref, 1) group spec, 2) tag key or reference to list of tag keys 4252# Returns: list of matching tags in list context, or first match in scalar context 4253# Notes: Group spec may contain multiple groups separated by colons, each 4254# possibly with a leading family number 4255sub GroupMatches($$$) 4256{ 4257 my ($self, $group, $tagList) = @_; 4258 $tagList = [ $tagList ] unless ref $tagList; 4259 my ($tag, @matches); 4260 # check each group name individually (eg. "Author:1IPTC") 4261 my @grps = split ':', $group; 4262 my (@fmys, $g); 4263 for ($g=0; $g<@grps; ++$g) { 4264 if ($grps[$g] =~ s/^(\d*)(id-)?//i) { 4265 $fmys[$g] = $1 if length $1; 4266 if ($2) { 4267 $fmys[$g] = 7; 4268 next; # (don't convert tag ID's to lower case) 4269 } 4270 } 4271 $grps[$g] = lc $grps[$g]; 4272 $grps[$g] = '' if $grps[$g] eq 'copy0'; # accept 'Copy0' for primary tag 4273 } 4274 foreach $tag (@$tagList) { 4275 my @groups = $self->GetGroup($tag, -1); 4276 for ($g=0; $g<@grps; ++$g) { 4277 my $grp = $grps[$g]; 4278 next if $grp eq '*' or $grp eq 'all'; 4279 my $f; 4280 if (defined($f = $fmys[$g])) { 4281 last unless defined $groups[$f]; 4282 if ($f == 7) { 4283 next if IsSameID($self->GetTagID($tag), $grp); 4284 } else { 4285 next if $grp eq lc $groups[$f]; 4286 } 4287 last; 4288 } else { 4289 last unless grep /^$grp$/i, @groups; 4290 } 4291 } 4292 if ($g == @grps) { 4293 return $tag unless wantarray; 4294 push @matches, $tag; 4295 } 4296 } 4297 return wantarray ? @matches : $matches[0]; 4298} 4299 4300#------------------------------------------------------------------------------ 4301# Remove specified tags from returned tag list, updating indices in other lists 4302# Inputs: 0) tag list ref, 1) index list ref, 2) index list ref, 3) hash ref, 4303# 4) true to include tags from hash instead of excluding 4304# Returns: nothing, but updates input lists 4305sub RemoveTagsFromList($$$$;$) 4306{ 4307 local $_; 4308 my ($tags, $list1, $list2, $exclude, $inv) = @_; 4309 my @filteredTags; 4310 4311 if (@$list1 or @$list2) { 4312 while (@$tags) { 4313 my $tag = pop @$tags; 4314 my $i = @$tags; 4315 if ($$exclude{$tag} xor $inv) { 4316 # remove index of excluded tag from each list 4317 @$list1 = map { $_ < $i ? $_ : $_ == $i ? () : $_ - 1 } @$list1; 4318 @$list2 = map { $_ < $i ? $_ : $_ == $i ? () : $_ - 1 } @$list2; 4319 } else { 4320 unshift @filteredTags, $tag; 4321 } 4322 } 4323 } else { 4324 foreach (@$tags) { 4325 push @filteredTags, $_ unless $$exclude{$_} xor $inv; 4326 } 4327 } 4328 $_[0] = \@filteredTags; # update tag list 4329} 4330 4331#------------------------------------------------------------------------------ 4332# Set list of found tags from previously requested tags 4333# Inputs: 0) ExifTool object reference 4334# Returns: 0) Reference to list of found tag keys (in order of requested tags) 4335# 1) Reference to list of indices for tags requested by value 4336# 2) Reference to list of indices for tags specified by wildcard or "all" 4337# Notes: index lists are returned in increasing order 4338sub SetFoundTags($) 4339{ 4340 my $self = shift; 4341 my $options = $$self{OPTIONS}; 4342 my $reqTags = $$self{REQUESTED_TAGS} || [ ]; 4343 my $duplicates = $$options{Duplicates}; 4344 my $exclude = $$options{Exclude}; 4345 my $fileOrder = $$self{FILE_ORDER}; 4346 my @groupOptions = sort grep /^Group/, keys %$options; 4347 my $doDups = $duplicates || $exclude || @groupOptions; 4348 my ($tag, $rtnTags, @byValue, @wildTags); 4349 4350 # only return requested tags if specified 4351 if (@$reqTags) { 4352 $rtnTags or $rtnTags = [ ]; 4353 # scan through the requested tags and generate a list of tags we found 4354 my $tagHash = $$self{VALUE}; 4355 my $reqTag; 4356 foreach $reqTag (@$reqTags) { 4357 my (@matches, $group, $allGrp, $allTag, $byValue); 4358 if ($reqTag =~ /^(.*):(.+)/) { 4359 ($group, $tag) = ($1, $2); 4360 if ($group =~ /^(\*|all)$/i) { 4361 $allGrp = 1; 4362 } elsif ($group !~ /^[-\w:]*$/) { 4363 $self->Warn("Invalid group name '${group}'"); 4364 $group = 'invalid'; 4365 } 4366 } else { 4367 $tag = $reqTag; 4368 } 4369 $byValue = 1 if $tag =~ s/#$// and $$options{PrintConv}; 4370 if (defined $$tagHash{$reqTag} and not $doDups) { 4371 $matches[0] = $tag; 4372 } elsif ($tag =~ /^(\*|all)$/i) { 4373 # tag name of '*' or 'all' matches all tags 4374 if ($doDups or $allGrp) { 4375 @matches = grep(!/#/, keys %$tagHash); 4376 } else { 4377 @matches = grep(!/ /, keys %$tagHash); 4378 } 4379 next unless @matches; # don't want entry in list for '*' tag 4380 $allTag = 1; 4381 } elsif ($tag =~ /[*?]/) { 4382 # allow wildcards in tag names 4383 $tag =~ s/\*/[-\\w]*/g; 4384 $tag =~ s/\?/[-\\w]/g; 4385 $tag .= '( \\(.*)?' if $doDups or $allGrp; 4386 @matches = grep(/^$tag$/i, keys %$tagHash); 4387 next unless @matches; # don't want entry in list for wildcard tags 4388 $allTag = 1; 4389 } elsif ($doDups or defined $group) { 4390 # must also look for tags like "Tag (1)" 4391 # (but be sure not to match temporary ValueConv entries like "Tag #") 4392 @matches = grep(/^$tag( \(|$)/i, keys %$tagHash); 4393 } elsif ($tag =~ /^[-\w]+$/) { 4394 # find first matching value 4395 # (use in list context to return value instead of count) 4396 ($matches[0]) = grep /^$tag$/i, keys %$tagHash; 4397 defined $matches[0] or undef @matches; 4398 } else { 4399 $self->Warn("Invalid tag name '${tag}'"); 4400 } 4401 if (defined $group and not $allGrp) { 4402 # keep only specified group 4403 @matches = $self->GroupMatches($group, \@matches); 4404 next unless @matches or not $allTag; 4405 } 4406 if (@matches > 1) { 4407 # maintain original file order for multiple tags 4408 @matches = sort { $$fileOrder{$a} <=> $$fileOrder{$b} } @matches; 4409 # return only the highest priority tag unless duplicates wanted 4410 unless ($doDups or $allTag or $allGrp) { 4411 $tag = shift @matches; 4412 my $oldPriority = $$self{PRIORITY}{$tag} || 1; 4413 foreach (@matches) { 4414 my $priority = $$self{PRIORITY}{$_}; 4415 $priority = 1 unless defined $priority; 4416 next unless $priority >= $oldPriority; 4417 $tag = $_; 4418 $oldPriority = $priority || 1; 4419 } 4420 @matches = ( $tag ); 4421 } 4422 } elsif (not @matches) { 4423 # put entry in return list even without value (value is undef) 4424 $matches[0] = $byValue ? "$tag #(0)" : "$tag (0)"; 4425 # bogus file order entry to avoid warning if sorting in file order 4426 $$self{FILE_ORDER}{$matches[0]} = 9999; 4427 } 4428 # save indices of tags extracted by value 4429 push @byValue, scalar(@$rtnTags) .. (scalar(@$rtnTags)+scalar(@matches)-1) if $byValue; 4430 # save indices of wildcard tags 4431 push @wildTags, scalar(@$rtnTags) .. (scalar(@$rtnTags)+scalar(@matches)-1) if $allTag; 4432 push @$rtnTags, @matches; 4433 } 4434 } else { 4435 # no requested tags, so we want all tags 4436 my @allTags; 4437 if ($doDups) { 4438 @allTags = keys %{$$self{VALUE}}; 4439 } else { 4440 # only include tag if it doesn't end in a copy number 4441 @allTags = grep(!/ /, keys %{$$self{VALUE}}); 4442 } 4443 $rtnTags = \@allTags; 4444 } 4445 4446 # filter excluded tags and group options 4447 while (($exclude or @groupOptions) and @$rtnTags) { 4448 if ($exclude) { 4449 my ($pat, %exclude); 4450 foreach $pat (@$exclude) { 4451 my $group; 4452 if ($pat =~ /^(.*):(.+)/) { 4453 ($group, $tag) = ($1, $2); 4454 if ($group =~ /^(\*|all)$/i) { 4455 undef $group; 4456 } elsif ($group !~ /^[-\w:]*$/) { 4457 $self->Warn("Invalid group name '${group}'"); 4458 $group = 'invalid'; 4459 } 4460 } else { 4461 $tag = $pat; 4462 } 4463 my @matches; 4464 if ($tag =~ /^(\*|all)$/i) { 4465 @matches = @$rtnTags; 4466 } else { 4467 # allow wildcards in tag names 4468 $tag =~ s/\*/[-\\w]*/g; 4469 $tag =~ s/\?/[-\\w]/g; 4470 @matches = grep(/^$tag( |$)/i, @$rtnTags); 4471 } 4472 @matches = $self->GroupMatches($group, \@matches) if $group and @matches; 4473 $exclude{$_} = 1 foreach @matches; 4474 } 4475 if (%exclude) { 4476 # remove excluded tags from return list(s) 4477 RemoveTagsFromList($rtnTags, \@byValue, \@wildTags, \%exclude); 4478 last unless @$rtnTags; # all done if nothing left 4479 } 4480 last if $duplicates and not @groupOptions; 4481 } 4482 # filter groups if requested, or to remove duplicates 4483 my (%keepTags, %wantGroup, $family, $groupOpt); 4484 my $allGroups = 1; 4485 # build hash of requested/excluded group names for each group family 4486 my $wantOrder = 0; 4487 foreach $groupOpt (@groupOptions) { 4488 $groupOpt =~ /^Group(\d*(:\d+)*)/ or next; 4489 $family = $1 || 0; 4490 $wantGroup{$family} or $wantGroup{$family} = { }; 4491 my $groupList; 4492 if (ref $$options{$groupOpt} eq 'ARRAY') { 4493 $groupList = $$options{$groupOpt}; 4494 } else { 4495 $groupList = [ $$options{$groupOpt} ]; 4496 } 4497 foreach (@$groupList) { 4498 # groups have priority in order they were specified 4499 ++$wantOrder; 4500 my ($groupName, $want); 4501 if (/^-(.*)/) { 4502 # excluded group begins with '-' 4503 $groupName = $1; 4504 $want = 0; # we don't want tags in this group 4505 } else { 4506 $groupName = $_; 4507 $want = $wantOrder; # we want tags in this group 4508 $allGroups = 0; # don't want all groups if we requested one 4509 } 4510 $wantGroup{$family}{$groupName} = $want; 4511 } 4512 } 4513 # loop through all tags and decide which ones we want 4514 my (@tags, %bestTag); 4515GR_TAG: foreach $tag (@$rtnTags) { 4516 my $wantTag = $allGroups; # want tag by default if want all groups 4517 foreach $family (keys %wantGroup) { 4518 my $group = $self->GetGroup($tag, $family); 4519 my $wanted = $wantGroup{$family}{$group}; 4520 next unless defined $wanted; 4521 next GR_TAG unless $wanted; # skip tag if group excluded 4522 # take lowest non-zero want flag 4523 next if $wantTag and $wantTag < $wanted; 4524 $wantTag = $wanted; 4525 } 4526 next unless $wantTag; 4527 $duplicates and $keepTags{$tag} = 1, next; 4528 # determine which tag we want to keep 4529 my $tagName = GetTagName($tag); 4530 my $bestTag = $bestTag{$tagName}; 4531 if (defined $bestTag) { 4532 next if $wantTag > $keepTags{$bestTag}; 4533 if ($wantTag == $keepTags{$bestTag}) { 4534 # want two tags with the same name -- keep the latest one 4535 if ($tag =~ / \((\d+)\)$/) { 4536 my $tagNum = $1; 4537 next if $bestTag !~ / \((\d+)\)$/ or $1 > $tagNum; 4538 } 4539 } 4540 # this tag is better, so delete old best tag 4541 delete $keepTags{$bestTag}; 4542 } 4543 $keepTags{$tag} = $wantTag; # keep this tag (for now...) 4544 $bestTag{$tagName} = $tag; # this is our current best tag 4545 } 4546 # include only tags we want to keep in return lists 4547 RemoveTagsFromList($rtnTags, \@byValue, \@wildTags, \%keepTags, 1); 4548 last; 4549 } 4550 $$self{FOUND_TAGS} = $rtnTags; # save found tags 4551 4552 # return reference to found tag keys (and list of indices of tags to extract by value) 4553 return wantarray ? ($rtnTags, \@byValue, \@wildTags) : $rtnTags; 4554} 4555 4556#------------------------------------------------------------------------------ 4557# Utility to load our write routines if required (called via AUTOLOAD) 4558# Inputs: 0) autoload function, 1-N) function arguments 4559# Returns: result of function or dies if function not available 4560sub DoAutoLoad(@) 4561{ 4562 my $autoload = shift; 4563 my @callInfo = split(/::/, $autoload); 4564 my $file = 'Image/ExifTool/Write'; 4565 4566 return if $callInfo[$#callInfo] eq 'DESTROY'; 4567 if (@callInfo == 4) { 4568 # load Image/ExifTool/WriteMODULE.pl 4569 $file .= "$callInfo[2].pl"; 4570 } elsif ($callInfo[-1] eq 'ShiftTime') { 4571 $file = 'Image/ExifTool/Shift.pl'; # load Shift.pl 4572 } else { 4573 # load Image/ExifTool/Writer.pl 4574 $file .= 'r.pl'; 4575 } 4576 # attempt to load the package 4577 eval { require $file } or die "Error while attempting to call $autoload\n$@\n"; 4578 unless (defined &$autoload) { 4579 my @caller = caller(0); 4580 # reproduce Perl's standard 'undefined subroutine' message: 4581 die "Undefined subroutine $autoload called at $caller[1] line $caller[2]\n"; 4582 } 4583 no strict 'refs'; 4584 return &$autoload(@_); # call the function 4585} 4586 4587#------------------------------------------------------------------------------ 4588# AutoLoad our writer routines when necessary 4589# 4590sub AUTOLOAD 4591{ 4592 return DoAutoLoad($AUTOLOAD, @_); 4593} 4594 4595#------------------------------------------------------------------------------ 4596# Add warning tag 4597# Inputs: 0) ExifTool object reference, 1) warning message 4598# 2) true if minor (2 if behaviour changes when warning is ignored, 4599# or 3 if warning shouldn't be issued when Validate option is used) 4600# Returns: true if warning tag was added 4601sub Warn($$;$) 4602{ 4603 my ($self, $str, $ignorable) = @_; 4604 if ($ignorable) { 4605 return 0 if $$self{OPTIONS}{IgnoreMinorErrors}; 4606 return 0 if $ignorable eq '3' and $$self{OPTIONS}{Validate}; 4607 $str = $ignorable eq '2' ? "[Minor] $str" : "[minor] $str"; 4608 } 4609 $self->FoundTag('Warning', $str); 4610 return 1; 4611} 4612 4613#------------------------------------------------------------------------------ 4614# Add warning tag only once per processed file 4615# Inputs: 0) ExifTool object reference, 1) warning message, 2) true if minor 4616# Returns: true if warning tag was added 4617sub WarnOnce($$;$) 4618{ 4619 my ($self, $str, $ignorable) = @_; 4620 return 0 if $ignorable and $$self{OPTIONS}{IgnoreMinorErrors}; 4621 unless ($$self{WARNED_ONCE}{$str}) { 4622 $self->Warn($str, $ignorable); 4623 $$self{WARNED_ONCE}{$str} = 1; 4624 } 4625 return 1; 4626} 4627 4628#------------------------------------------------------------------------------ 4629# Add error tag 4630# Inputs: 0) ExifTool object reference, 1) error message, 2) true if minor 4631# Returns: true if error tag was added, otherwise warning was added 4632sub Error($$;$) 4633{ 4634 my ($self, $str, $ignorable) = @_; 4635 if ($$self{DemoteErrors}) { 4636 $self->Warn($str) and ++$$self{DemoteErrors}; 4637 return 1; 4638 } elsif ($ignorable) { 4639 $$self{OPTIONS}{IgnoreMinorErrors} and $self->Warn($str), return 0; 4640 $str = "[minor] $str"; 4641 } 4642 $self->FoundTag('Error', $str); 4643 return 1; 4644} 4645 4646#------------------------------------------------------------------------------ 4647# Expand shortcuts 4648# Inputs: 0) reference to list of tags, 1) set to remove trailing '#' 4649# Notes: Handles leading '-' for excluded tags, trailing '#' for ValueConv, 4650# multiple group names, and redirected tags 4651sub ExpandShortcuts($;$) 4652{ 4653 my ($tagList, $removeSuffix) = @_; 4654 return unless $tagList and @$tagList; 4655 4656 require Image::ExifTool::Shortcuts; 4657 4658 # expand shortcuts 4659 my $suffix = $removeSuffix ? '' : '#'; 4660 my @expandedTags; 4661 my ($entry, $tag, $excl); 4662 foreach $entry (@$tagList) { 4663 # skip things like options hash references in list 4664 if (ref $entry) { 4665 push @expandedTags, $entry; 4666 next; 4667 } 4668 # remove leading '-' 4669 ($excl, $tag) = $entry =~ /^(-?)(.*)/s; 4670 my ($post, @post, $pre, $v); 4671 # handle redirection 4672 if (not $excl and $tag =~ /(.+?)([-+]?[<>].+)/s) { 4673 ($tag, $post) = ($1, $2); 4674 if ($post =~ /^[-+]?>/ or $post !~ /\$/) { 4675 # expand shortcuts in postfix (rhs of redirection) 4676 my ($op, $p2, $t2) = ($post =~ /([-+]?[<>])(.+:)?(.+)/); 4677 $p2 = '' unless defined $p2; 4678 $v = ($t2 =~ s/#$//) ? $suffix : ''; # ValueConv suffix 4679 my ($match) = grep /^\Q$t2\E$/i, keys %Image::ExifTool::Shortcuts::Main; 4680 if ($match) { 4681 foreach (@{$Image::ExifTool::Shortcuts::Main{$match}}) { 4682 /^-/ and next; # ignore excluded tags 4683 if ($p2 and /(.+:)(.+)/) { 4684 push @post, "$op$_$v"; 4685 } else { 4686 push @post, "$op$p2$_$v"; 4687 } 4688 } 4689 next unless @post; 4690 $post = shift @post; 4691 } 4692 } 4693 } else { 4694 $post = ''; 4695 } 4696 # handle group names 4697 if ($tag =~ /(.+:)(.+)/) { 4698 ($pre, $tag) = ($1, $2); 4699 } else { 4700 $pre = ''; 4701 } 4702 $v = ($tag =~ s/#$//) ? $suffix : ''; # ValueConv suffix 4703 # loop over all postfixes 4704 for (;;) { 4705 # expand the tag name 4706 my ($match) = grep /^\Q$tag\E$/i, keys %Image::ExifTool::Shortcuts::Main; 4707 if ($match) { 4708 if ($excl) { 4709 # entry starts with '-', so exclude all tags in this shortcut 4710 foreach (@{$Image::ExifTool::Shortcuts::Main{$match}}) { 4711 /^-/ and next; # ignore excluded exclude tags 4712 # group of expanded tag takes precedence 4713 if ($pre and /(.+:)(.+)/) { 4714 push @expandedTags, "$excl$_"; 4715 } else { 4716 push @expandedTags, "$excl$pre$_"; 4717 } 4718 } 4719 } elsif (length $pre or length $post or $v) { 4720 foreach (@{$Image::ExifTool::Shortcuts::Main{$match}}) { 4721 /(-?)(.+:)?(.+)/; 4722 if ($2) { 4723 # group from expanded tag takes precedence 4724 push @expandedTags, "$_$v$post"; 4725 } else { 4726 push @expandedTags, "$1$pre$3$v$post"; 4727 } 4728 } 4729 } else { 4730 push @expandedTags, @{$Image::ExifTool::Shortcuts::Main{$match}}; 4731 } 4732 } else { 4733 push @expandedTags, "$excl$pre$tag$v$post"; 4734 } 4735 last unless @post; 4736 $post = shift @post; 4737 } 4738 } 4739 @$tagList = @expandedTags; 4740} 4741 4742#------------------------------------------------------------------------------ 4743# Add hash of Composite tags to our composites 4744# Inputs: 0) hash reference to table of Composite tags to add or module name, 4745# 1) override existing tag definition 4746sub AddCompositeTags($;$) 4747{ 4748 local $_; 4749 my ($add, $override) = @_; 4750 my ($module, $prefix, $tagID); 4751 unless (ref $add) { 4752 ($prefix = $add) =~ s/.*:://; 4753 $module = $add; 4754 $add .= '::Composite'; 4755 no strict 'refs'; 4756 $add = \%$add; 4757 $prefix .= '-'; 4758 } else { 4759 $prefix = 'UserDefined-'; 4760 } 4761 my $defaultGroups = $$add{GROUPS}; 4762 my $compTable = GetTagTable('Image::ExifTool::Composite'); 4763 4764 # make sure default groups are defined in families 0 and 1 4765 if ($defaultGroups) { 4766 $$defaultGroups{0} or $$defaultGroups{0} = 'Composite'; 4767 $$defaultGroups{1} or $$defaultGroups{1} = 'Composite'; 4768 $$defaultGroups{2} or $$defaultGroups{2} = 'Other'; 4769 } else { 4770 $defaultGroups = $$add{GROUPS} = { 0 => 'Composite', 1 => 'Composite', 2 => 'Other' }; 4771 } 4772 SetupTagTable($add); # generate Name, TagID, etc 4773 foreach $tagID (sort keys %$add) { 4774 next if $specialTags{$tagID}; # must skip special tags 4775 my $tagInfo = $$add{$tagID}; 4776 my $new = $prefix . $tagID; # new tag ID for Composite table 4777 $$tagInfo{Module} = $module if $$tagInfo{Writable}; 4778 $$tagInfo{Override} = 1 if $override and not defined $$tagInfo{Override}; 4779 $$tagInfo{IsComposite} = 1; 4780 # handle Composite tags with the same name 4781 if ($compositeID{$tagID}) { 4782 # determine if we want to override this tag 4783 # (=0 keep both, >0 override, <0 keep existing) 4784 my $over = ($$tagInfo{Override} || 0) - ($$compTable{$compositeID{$tagID}[0]}{Override} || 0); 4785 next if $over < 0; 4786 if ($over) { 4787 # remove existing tags with this ID 4788 delete $$compTable{$_} foreach @{$compositeID{$tagID}}; 4789 delete $compositeID{$tagID}; 4790 } 4791 } 4792 # make sure new TagID is unique by adding index if necessary 4793 # (could only happen for UserDefined tags now that module name is added to tag ID) 4794 my $n = 0; 4795 while ($$compTable{$new}) { 4796 $new =~ s/-\d+$// if $n++; 4797 $new .= "-$n"; 4798 } 4799 # use new ID and save it so we can use it in TagLookup 4800 $$tagInfo{NewTagID} = $new unless $tagID eq $new; 4801 4802 # add new ID to lookup of Composite tag ID's 4803 $compositeID{$tagID} = [ ] unless $compositeID{$tagID}; 4804 unshift @{$compositeID{$tagID}}, $new; # (most recent one first) 4805 4806 # convert scalar Require/Desire/Inhibit entries 4807 my ($type, @hashes, @scalars, %used); 4808 foreach $type ('Require','Desire','Inhibit') { 4809 my $req = $$tagInfo{$type} or next; 4810 push @{ref($req) eq 'HASH' ? \@hashes : \@scalars}, $type; 4811 } 4812 if (@scalars) { 4813 # make lookup for indices that are used 4814 foreach $type (@hashes) { 4815 $used{$_} = 1 foreach keys %{$$tagInfo{$type}}; 4816 } 4817 my $next = 0; 4818 foreach $type (@scalars) { 4819 ++$next while $used{$next}; 4820 $$tagInfo{$type} = { $next++ => $$tagInfo{$type} }; 4821 } 4822 } 4823 # add this Composite tag to our main Composite table 4824 $$tagInfo{Table} = $compTable; 4825 # (use the original TagID, even if we changed it, so don't do this:) 4826 $$tagInfo{TagID} = $new; 4827 # save tag under new ID in Composite table 4828 $$compTable{$new} = $tagInfo; 4829 # set all default groups in tag 4830 my $groups = $$tagInfo{Groups}; 4831 $groups or $groups = $$tagInfo{Groups} = { }; 4832 # fill in default groups 4833 foreach (keys %$defaultGroups) { 4834 $$groups{$_} or $$groups{$_} = $$defaultGroups{$_}; 4835 } 4836 # set flag indicating group list was built 4837 $$tagInfo{GotGroups} = 1; 4838 } 4839} 4840 4841#------------------------------------------------------------------------------ 4842# Add tags to TagLookup (used for writing) 4843# Inputs: 0) source hash of tag definitions, 1) name of destination tag table 4844sub AddTagsToLookup($$) 4845{ 4846 my ($tagHash, $table) = @_; 4847 if (defined &Image::ExifTool::TagLookup::AddTags) { 4848 Image::ExifTool::TagLookup::AddTags($tagHash, $table); 4849 } elsif (not $Image::ExifTool::pluginTags{$tagHash}) { 4850 # queue these tags until TagLookup is loaded 4851 push @Image::ExifTool::pluginTags, [ $tagHash, $table ]; 4852 # set flag so we don't load same tags twice 4853 $Image::ExifTool::pluginTags{$tagHash} = 1; 4854 } 4855} 4856 4857#------------------------------------------------------------------------------ 4858# Expand tagInfo Flags 4859# Inputs: 0) tagInfo hash ref 4860# Notes: $$tagInfo{Flags} must be defined to call this routine 4861sub ExpandFlags($) 4862{ 4863 my $tagInfo = shift; 4864 my $flags = $$tagInfo{Flags}; 4865 if (ref $flags eq 'ARRAY') { 4866 foreach (@$flags) { 4867 $$tagInfo{$_} = 1; 4868 } 4869 } elsif (ref $flags eq 'HASH') { 4870 my $key; 4871 foreach $key (keys %$flags) { 4872 $$tagInfo{$key} = $$flags{$key}; 4873 } 4874 } else { 4875 $$tagInfo{$flags} = 1; 4876 } 4877} 4878 4879#------------------------------------------------------------------------------ 4880# Set up tag table (must be done once for each tag table used) 4881# Inputs: 0) Reference to tag table 4882# Notes: - generates 'Name' field from key if it doesn't exist 4883# - stores 'Table' pointer and 'TagID' value 4884# - expands 'Flags' for quick lookup 4885sub SetupTagTable($) 4886{ 4887 my $tagTablePtr = shift; 4888 my $avoid = $$tagTablePtr{AVOID}; 4889 my ($tagID, $tagInfo); 4890 foreach $tagID (TagTableKeys($tagTablePtr)) { 4891 my @infoArray = GetTagInfoList($tagTablePtr,$tagID); 4892 # process conditional tagInfo arrays 4893 foreach $tagInfo (@infoArray) { 4894 $$tagInfo{Table} = $tagTablePtr; 4895 $$tagInfo{TagID} = $tagID; 4896 $$tagInfo{Name} or $$tagInfo{Name} = MakeTagName($tagID); 4897 $$tagInfo{Flags} and ExpandFlags($tagInfo); 4898 $$tagInfo{Avoid} = $avoid if defined $avoid; 4899 # calculate BitShift from Mask if necessary 4900 if ($$tagInfo{Mask} and not defined $$tagInfo{BitShift}) { 4901 my ($mask, $bitShift) = ($$tagInfo{Mask}, 0); 4902 ++$bitShift until $mask & (1 << $bitShift); 4903 $$tagInfo{BitShift} = $bitShift; 4904 } 4905 } 4906 next unless @infoArray > 1; 4907 # add an "Index" member to each tagInfo in a list 4908 my $index = 0; 4909 foreach $tagInfo (@infoArray) { 4910 $$tagInfo{Index} = $index++; 4911 } 4912 } 4913} 4914 4915#------------------------------------------------------------------------------ 4916# Utilities to check for numerical types 4917# Inputs: 0) value; Returns: true if value is a numerical type 4918# Notes: May change commas to decimals in floats for use in other locales 4919sub IsFloat($) { 4920 return 1 if $_[0] =~ /^[+-]?(?=\d|\.\d)\d*(\.\d*)?([Ee]([+-]?\d+))?$/; 4921 # allow comma separators (for other locales) 4922 return 0 unless $_[0] =~ /^[+-]?(?=\d|,\d)\d*(,\d*)?([Ee]([+-]?\d+))?$/; 4923 $_[0] =~ tr/,/./; # but translate ',' to '.' 4924 return 1; 4925} 4926sub IsInt($) { return scalar($_[0] =~ /^[+-]?\d+$/); } 4927sub IsHex($) { return scalar($_[0] =~ /^(0x)?[0-9a-f]{1,8}$/i); } 4928sub IsRational($) { return scalar($_[0] =~ m{^[-+]?\d+/\d+$}); } 4929 4930# round floating point value to specified number of significant digits 4931# Inputs: 0) value, 1) number of sig digits; Returns: rounded number 4932sub RoundFloat($$) 4933{ 4934 my ($val, $sig) = @_; 4935 return sprintf("%.${sig}g", $val); 4936} 4937 4938# Convert strings to floating point numbers (or undef) 4939# Inputs: 0-N) list of strings (may be undef) 4940# Returns: last value converted 4941sub ToFloat(@) 4942{ 4943 local $_; 4944 foreach (@_) { 4945 next unless defined $_; 4946 # (add 0 to convert "0.0" to "0" for tests) 4947 $_ = /((?:[+-]?)(?=\d|\.\d)\d*(?:\.\d*)?(?:[Ee](?:[+-]?\d+))?)/ ? $1 + 0 : undef; 4948 } 4949 return $_[-1]; 4950} 4951 4952#------------------------------------------------------------------------------ 4953# Utility routines to for reading binary data values from file 4954 4955my %unpackMotorola = ( S => 'n', L => 'N', C => 'C', c => 'c' ); 4956my %unpackIntel = ( S => 'v', L => 'V', C => 'C', c => 'c' ); 4957my %unpackRev = ( N => 'V', V => 'N', C => 'C', n => 'v', v => 'n', c => 'c' ); 4958 4959# the following 4 variables are defined in 'use vars' instead of using 'my' 4960# because mod_perl 5.6.1 apparently has a problem with setting file-scope 'my' 4961# variables from within subroutines (ref communication with Pavel Merdin): 4962# $swapBytes - set if EXIF header is not native byte ordering 4963# $swapWords - swap 32-bit words in doubles (ARM quirk) 4964$currentByteOrder = 'MM'; # current byte ordering ('II' or 'MM') 4965%unpackStd = %unpackMotorola; 4966 4967# Swap bytes in data if necessary 4968# Inputs: 0) data, 1) number of bytes 4969# Returns: swapped data 4970sub SwapBytes($$) 4971{ 4972 return $_[0] unless $swapBytes; 4973 my ($val, $bytes) = @_; 4974 my $newVal = ''; 4975 $newVal .= substr($val, $bytes, 1) while $bytes--; 4976 return $newVal; 4977} 4978# Swap words. Inputs: 8 bytes of data, Returns: swapped data 4979sub SwapWords($) 4980{ 4981 return $_[0] unless $swapWords and length($_[0]) == 8; 4982 return substr($_[0],4,4) . substr($_[0],0,4) 4983} 4984 4985# Unpack value, letting unpack() handle byte swapping 4986# Inputs: 0) unpack template, 1) data reference, 2) offset 4987# Returns: unpacked number 4988# - uses value of %unpackStd to determine the unpack template 4989# - can only be called for 'S' or 'L' templates since these are the only 4990# templates for which you can specify the byte ordering. 4991sub DoUnpackStd(@) 4992{ 4993 $_[2] and return unpack("x$_[2] $unpackStd{$_[0]}", ${$_[1]}); 4994 return unpack($unpackStd{$_[0]}, ${$_[1]}); 4995} 4996# same, but with reversed byte order 4997sub DoUnpackRev(@) 4998{ 4999 my $fmt = $unpackRev{$unpackStd{$_[0]}}; 5000 $_[2] and return unpack("x$_[2] $fmt", ${$_[1]}); 5001 return unpack($fmt, ${$_[1]}); 5002} 5003# Pack value 5004# Inputs: 0) template, 1) value, 2) data ref (or undef), 3) offset (if data ref) 5005# Returns: packed value 5006sub DoPackStd(@) 5007{ 5008 my $val = pack($unpackStd{$_[0]}, $_[1]); 5009 $_[2] and substr(${$_[2]}, $_[3], length($val)) = $val; 5010 return $val; 5011} 5012# same, but with reversed byte order 5013sub DoPackRev(@) 5014{ 5015 my $val = pack($unpackRev{$unpackStd{$_[0]}}, $_[1]); 5016 $_[2] and substr(${$_[2]}, $_[3], length($val)) = $val; 5017 return $val; 5018} 5019 5020# Unpack value, handling the byte swapping manually 5021# Inputs: 0) # bytes, 1) unpack template, 2) data reference, 3) offset 5022# Returns: unpacked number 5023# - uses value of $swapBytes to determine byte ordering 5024sub DoUnpack(@) 5025{ 5026 my ($bytes, $template, $dataPt, $pos) = @_; 5027 my $val; 5028 if ($swapBytes) { 5029 $val = ''; 5030 $val .= substr($$dataPt,$pos+$bytes,1) while $bytes--; 5031 } else { 5032 $val = substr($$dataPt,$pos,$bytes); 5033 } 5034 defined($val) or return undef; 5035 return unpack($template,$val); 5036} 5037 5038# Unpack double value 5039# Inputs: 0) unpack template, 1) data reference, 2) offset 5040# Returns: unpacked number 5041sub DoUnpackDbl(@) 5042{ 5043 my ($template, $dataPt, $pos) = @_; 5044 my $val = substr($$dataPt,$pos,8); 5045 defined($val) or return undef; 5046 # swap bytes and 32-bit words (ARM quirk) if necessary, then unpack value 5047 return unpack($template, SwapWords(SwapBytes($val, 8))); 5048} 5049 5050# Inputs: 0) data reference, 1) offset into data 5051sub Get8s($$) { return DoUnpackStd('c', @_); } 5052sub Get8u($$) { return DoUnpackStd('C', @_); } 5053sub Get16s($$) { return DoUnpack(2, 's', @_); } 5054sub Get16u($$) { return DoUnpackStd('S', @_); } 5055sub Get32s($$) { return DoUnpack(4, 'l', @_); } 5056sub Get32u($$) { return DoUnpackStd('L', @_); } 5057sub GetFloat($$) { return DoUnpack(4, 'f', @_); } 5058sub GetDouble($$) { return DoUnpackDbl('d', @_); } 5059sub Get16uRev($$) { return DoUnpackRev('S', @_); } 5060sub Get32uRev($$) { return DoUnpackRev('L', @_); } 5061 5062# rationals may be a floating point number, 'inf' or 'undef' 5063my ($ratNumer, $ratDenom); 5064sub GetRational32s($$) 5065{ 5066 my ($dataPt, $pos) = @_; 5067 $ratNumer = Get16s($dataPt,$pos); 5068 $ratDenom = Get16s($dataPt, $pos + 2) or return $ratNumer ? 'inf' : 'undef'; 5069 # round off to a reasonable number of significant figures 5070 return RoundFloat($ratNumer / $ratDenom, 7); 5071} 5072sub GetRational32u($$) 5073{ 5074 my ($dataPt, $pos) = @_; 5075 $ratNumer = Get16u($dataPt,$pos); 5076 $ratDenom = Get16u($dataPt, $pos + 2) or return $ratNumer ? 'inf' : 'undef'; 5077 return RoundFloat($ratNumer / $ratDenom, 7); 5078} 5079sub GetRational64s($$) 5080{ 5081 my ($dataPt, $pos) = @_; 5082 $ratNumer = Get32s($dataPt,$pos); 5083 $ratDenom = Get32s($dataPt, $pos + 4) or return $ratNumer ? 'inf' : 'undef'; 5084 return RoundFloat($ratNumer / $ratDenom, 10); 5085} 5086sub GetRational64u($$) 5087{ 5088 my ($dataPt, $pos) = @_; 5089 $ratNumer = Get32u($dataPt,$pos); 5090 $ratDenom = Get32u($dataPt, $pos + 4) or return $ratNumer ? 'inf' : 'undef'; 5091 return RoundFloat($ratNumer / $ratDenom, 10); 5092} 5093sub GetFixed16s($$) 5094{ 5095 my ($dataPt, $pos) = @_; 5096 my $val = Get16s($dataPt, $pos) / 0x100; 5097 return int($val * 1000 + ($val<0 ? -0.5 : 0.5)) / 1000; 5098} 5099sub GetFixed16u($$) 5100{ 5101 my ($dataPt, $pos) = @_; 5102 return int((Get16u($dataPt, $pos) / 0x100) * 1000 + 0.5) / 1000; 5103} 5104sub GetFixed32s($$) 5105{ 5106 my ($dataPt, $pos) = @_; 5107 my $val = Get32s($dataPt, $pos) / 0x10000; 5108 # remove insignificant digits 5109 return int($val * 1e5 + ($val>0 ? 0.5 : -0.5)) / 1e5; 5110} 5111sub GetFixed32u($$) 5112{ 5113 my ($dataPt, $pos) = @_; 5114 # remove insignificant digits 5115 return int((Get32u($dataPt, $pos) / 0x10000) * 1e5 + 0.5) / 1e5; 5116} 5117# Inputs: 0) value, 1) data ref, 2) offset 5118sub Set8s(@) { return DoPackStd('c', @_); } 5119sub Set8u(@) { return DoPackStd('C', @_); } 5120sub Set16u(@) { return DoPackStd('S', @_); } 5121sub Set32u(@) { return DoPackStd('L', @_); } 5122sub Set16uRev(@) { return DoPackRev('S', @_); } 5123 5124#------------------------------------------------------------------------------ 5125# Get current byte order ('II' or 'MM') 5126sub GetByteOrder() { return $currentByteOrder; } 5127 5128#------------------------------------------------------------------------------ 5129# Set byte ordering 5130# Inputs: 0) 'MM'=motorola, 'II'=intel (will translate 'BigEndian', 'LittleEndian') 5131# Returns: 1 on success 5132sub SetByteOrder($) 5133{ 5134 my $order = shift; 5135 5136 if ($order eq 'MM') { # big endian (Motorola) 5137 %unpackStd = %unpackMotorola; 5138 } elsif ($order eq 'II') { # little endian (Intel) 5139 %unpackStd = %unpackIntel; 5140 } elsif ($order =~ /^Big/i) { 5141 $order = 'MM'; 5142 %unpackStd = %unpackMotorola; 5143 } elsif ($order =~ /^Little/i) { 5144 $order = 'II'; 5145 %unpackStd = %unpackIntel; 5146 } else { 5147 return 0; 5148 } 5149 my $val = unpack('S','A '); 5150 my $nativeOrder; 5151 if ($val == 0x4120) { # big endian 5152 $nativeOrder = 'MM'; 5153 } elsif ($val == 0x2041) { # little endian 5154 $nativeOrder = 'II'; 5155 } else { 5156 warn sprintf("Unknown native byte order! (pattern %x)\n",$val); 5157 return 0; 5158 } 5159 $currentByteOrder = $order; # save current byte order 5160 5161 # swap bytes if our native CPU byte ordering is not the same as the EXIF 5162 $swapBytes = ($order ne $nativeOrder); 5163 5164 # little-endian ARM has big-endian words for doubles (thanks Riku Voipio) 5165 # (Note: Riku's patch checked for '0ff3', but I think it should be 'f03f' since 5166 # 1 is '000000000000f03f' on an x86 -- so check for both, but which is correct?) 5167 my $pack1d = pack('d', 1); 5168 $swapWords = ($pack1d eq "\0\0\x0f\xf3\0\0\0\0" or 5169 $pack1d eq "\0\0\xf0\x3f\0\0\0\0"); 5170 return 1; 5171} 5172 5173#------------------------------------------------------------------------------ 5174# Change byte order 5175sub ToggleByteOrder() 5176{ 5177 SetByteOrder(GetByteOrder() eq 'II' ? 'MM' : 'II'); 5178} 5179 5180#------------------------------------------------------------------------------ 5181# hash lookups for reading values from data 5182my %formatSize = ( 5183 int8s => 1, 5184 int8u => 1, 5185 int16s => 2, 5186 int16u => 2, 5187 int16uRev => 2, 5188 int32s => 4, 5189 int32u => 4, 5190 int32uRev => 4, 5191 int64s => 8, 5192 int64u => 8, 5193 rational32s => 4, 5194 rational32u => 4, 5195 rational64s => 8, 5196 rational64u => 8, 5197 fixed16s => 2, 5198 fixed16u => 2, 5199 fixed32s => 4, 5200 fixed32u => 4, 5201 fixed64s => 8, 5202 float => 4, 5203 double => 8, 5204 extended => 10, 5205 unicode => 2, 5206 complex => 8, 5207 string => 1, 5208 binary => 1, 5209 'undef' => 1, 5210 ifd => 4, 5211 ifd64 => 8, 5212 ue7 => 1, 5213); 5214my %readValueProc = ( 5215 int8s => \&Get8s, 5216 int8u => \&Get8u, 5217 int16s => \&Get16s, 5218 int16u => \&Get16u, 5219 int16uRev => \&Get16uRev, 5220 int32s => \&Get32s, 5221 int32u => \&Get32u, 5222 int32uRev => \&Get32uRev, 5223 int64s => \&Get64s, 5224 int64u => \&Get64u, 5225 rational32s => \&GetRational32s, 5226 rational32u => \&GetRational32u, 5227 rational64s => \&GetRational64s, 5228 rational64u => \&GetRational64u, 5229 fixed16s => \&GetFixed16s, 5230 fixed16u => \&GetFixed16u, 5231 fixed32s => \&GetFixed32s, 5232 fixed32u => \&GetFixed32u, 5233 fixed64s => \&GetFixed64s, 5234 float => \&GetFloat, 5235 double => \&GetDouble, 5236 extended => \&GetExtended, 5237 ifd => \&Get32u, 5238 ifd64 => \&Get64u, 5239); 5240# lookup for all rational types 5241my %isRational = ( 5242 rational32u => 1, 5243 rational32s => 1, 5244 rational64u => 1, 5245 rational64s => 1, 5246); 5247sub FormatSize($) { return $formatSize{$_[0]}; } 5248 5249#------------------------------------------------------------------------------ 5250# Read value from binary data (with current byte ordering) 5251# Inputs: 0) data reference, 1) value offset, 2) format string, 5252# 3) number of values (or undef to use all data), 5253# 4) valid data length relative to offset (or undef to use all data), 5254# 5) optional pointer to returned rational 5255# Returns: converted value, or undefined if data isn't there 5256# or list of values in list context 5257sub ReadValue($$$;$$$) 5258{ 5259 my ($dataPt, $offset, $format, $count, $size, $ratPt) = @_; 5260 5261 my $len = $formatSize{$format}; 5262 unless ($len) { 5263 warn "Unknown format $format"; 5264 $len = 1; 5265 } 5266 $size = length($$dataPt) - $offset unless defined $size; 5267 unless ($count) { 5268 return '' if defined $count or $size < $len; 5269 $count = int($size / $len); 5270 } 5271 # make sure entry is inside data 5272 if ($len * $count > $size) { 5273 $count = int($size / $len); # shorten count if necessary 5274 $count < 1 and return undef; # return undefined if no data 5275 } 5276 my @vals; 5277 my $proc = $readValueProc{$format}; 5278 if (not $proc) { 5279 # handle undef/binary/string (also unsupported unicode/complex) 5280 $vals[0] = substr($$dataPt, $offset, $count * $len); 5281 # truncate string at null terminator if necessary 5282 $vals[0] =~ s/\0.*//s if $format eq 'string'; 5283 } elsif ($isRational{$format} and $ratPt) { 5284 # store rationals separately as string fractions 5285 my @rat; 5286 for (;;) { 5287 push @vals, &$proc($dataPt, $offset); 5288 push @rat, "$ratNumer/$ratDenom"; 5289 last if --$count <= 0; 5290 $offset += $len; 5291 } 5292 $$ratPt = join(' ',@rat); 5293 } else { 5294 for (;;) { 5295 push @vals, &$proc($dataPt, $offset); 5296 last if --$count <= 0; 5297 $offset += $len; 5298 } 5299 } 5300 return @vals if wantarray; 5301 return join(' ', @vals) if @vals > 1; 5302 return $vals[0]; 5303} 5304 5305#------------------------------------------------------------------------------ 5306# Decode string with specified encoding 5307# Inputs: 0) ExifTool object ref, 1) string to decode 5308# 2) source character set name (undef for current Charset) 5309# 3) optional source byte order (2-byte and 4-byte fixed-width sets only) 5310# 4) optional destination character set (defaults to Charset setting) 5311# 5) optional destination byte order (2-byte and 4-byte fixed-width only) 5312# Returns: string in destination encoding 5313# Note: ExifTool ref may be undef if character both character sets are provided 5314# (but in this case no warnings will be issued) 5315sub Decode($$$;$$$) 5316{ 5317 my ($self, $val, $from, $fromOrder, $to, $toOrder) = @_; 5318 $from or $from = $$self{OPTIONS}{Charset}; 5319 $to or $to = $$self{OPTIONS}{Charset}; 5320 if ($from ne $to and length $val) { 5321 require Image::ExifTool::Charset; 5322 my $cs1 = $Image::ExifTool::Charset::csType{$from}; 5323 my $cs2 = $Image::ExifTool::Charset::csType{$to}; 5324 if ($cs1 and $cs2 and not $cs2 & 0x002) { 5325 # treat as straight ASCII if no character will need remapping 5326 if (($cs1 | $cs2) & 0x680 or $val =~ /[\x80-\xff]/) { 5327 my $uni = Image::ExifTool::Charset::Decompose($self, $val, $from, $fromOrder); 5328 $val = Image::ExifTool::Charset::Recompose($self, $uni, $to, $toOrder); 5329 } 5330 } elsif ($self) { 5331 my $set = $cs1 ? $to : $from; 5332 unless ($$self{"DecodeWarn$set"}) { 5333 $self->Warn("Unsupported character set ($set)"); 5334 $$self{"DecodeWarn$set"} = 1; 5335 } 5336 } 5337 } 5338 return $val; 5339} 5340 5341#------------------------------------------------------------------------------ 5342# Encode string with specified encoding 5343# Inputs: 0) ExifTool object ref, 1) string, 2) destination character set name, 5344# 3) optional destination byte order (2-byte and 4-byte fixed-width sets only) 5345# Returns: string in specified encoding 5346sub Encode($$$;$) 5347{ 5348 my ($self, $val, $to, $toOrder) = @_; 5349 return $self->Decode($val, undef, undef, $to, $toOrder); 5350} 5351 5352#------------------------------------------------------------------------------ 5353# Decode bit mask 5354# Inputs: 0) value to decode, 1) Reference to hash for decoding (or undef) 5355# 2) optional bits per word (defaults to 32) 5356sub DecodeBits($$;$) 5357{ 5358 my ($vals, $lookup, $bits) = @_; 5359 $bits or $bits = 32; 5360 my ($val, $i, @bitList); 5361 my $num = 0; 5362 foreach $val (split ' ', $vals) { 5363 for ($i=0; $i<$bits; ++$i) { 5364 next unless $val & (1 << $i); 5365 my $n = $i + $num; 5366 if (not $lookup) { 5367 push @bitList, $n; 5368 } elsif ($$lookup{$n}) { 5369 push @bitList, $$lookup{$n}; 5370 } else { 5371 push @bitList, "[$n]"; 5372 } 5373 } 5374 $num += $bits; 5375 } 5376 return '(none)' unless @bitList; 5377 return join($lookup ? ', ' : ',', @bitList); 5378} 5379 5380#------------------------------------------------------------------------------ 5381# Validate an extracted image and repair if necessary 5382# Inputs: 0) ExifTool object reference, 1) image reference, 2) tag name or key 5383# Returns: image reference or undef if it wasn't valid 5384# Note: should be called from RawConv, not ValueConv 5385sub ValidateImage($$$) 5386{ 5387 my ($self, $imagePt, $tag) = @_; 5388 return undef if $$imagePt eq 'none'; 5389 unless ($$imagePt =~ /^(Binary data|\xff\xd8\xff)/ or 5390 # the first byte of the preview of some Minolta cameras is wrong, 5391 # so check for this and set it back to 0xff if necessary 5392 $$imagePt =~ s/^.(\xd8\xff\xdb)/\xff$1/s or 5393 $self->Options('IgnoreMinorErrors')) 5394 { 5395 # issue warning only if the tag was specifically requested 5396 if ($$self{REQ_TAG_LOOKUP}{lc GetTagName($tag)}) { 5397 $self->Warn("$tag is not a valid JPEG image",1); 5398 return undef; 5399 } 5400 } 5401 return $imagePt; 5402} 5403 5404#------------------------------------------------------------------------------ 5405# Validate a tag name argument (including group name and wildcards, etc) 5406# Inputs: 0) tag name 5407# Returns: true if tag name is valid 5408# - a tag name may contain [-_A-Za-z0-9], but may not start with [-0-9] 5409# - tag names may contain wildcards [?*], and end with a hash [#] 5410# - may have group name prefixes (which may have family number prefix), separated by colons 5411# - a group name may be zero or more characters 5412sub ValidTagName($) 5413{ 5414 my $tag = shift; 5415 return $tag =~ /^(([-\w]*|\d*\*):)*[_a-zA-Z?*][-\w?*]*#?$/; 5416} 5417 5418#------------------------------------------------------------------------------ 5419# Generate a valid tag name based on the tag ID or name 5420# Inputs: 0) tag ID or name 5421# Returns: valid tag name 5422sub MakeTagName($) 5423{ 5424 my $name = shift; 5425 $name =~ tr/-_a-zA-Z0-9//dc; # remove illegal characters 5426 $name = ucfirst $name; # capitalize first letter 5427 $name = "Tag$name" if length($name) < 2; # must at least 2 characters long 5428 return $name; 5429} 5430 5431#------------------------------------------------------------------------------ 5432# Make description from a tag name 5433# Inputs: 0) tag name 1) optional tagID to add at end of description 5434# Returns: description 5435sub MakeDescription($;$) 5436{ 5437 my ($tag, $tagID) = @_; 5438 # start with the tag name and force first letter to be upper case 5439 my $desc = ucfirst($tag); 5440 # translate underlines to spaces 5441 $desc =~ tr/_/ /; 5442 # remove hex TagID from name (to avoid inserting spaces in the number) 5443 $desc =~ s/ (0x[\da-f]+)$//i and $tagID = $1 unless defined $tagID; 5444 # put a space between lower/UPPER case and lower/number combinations 5445 $desc =~ s/([a-z])([A-Z\d])/$1 $2/g; 5446 # put a space between acronyms and words 5447 $desc =~ s/([A-Z])([A-Z][a-z])/$1 $2/g; 5448 # put spaces after numbers (if more than one character follows the number) 5449 $desc =~ s/(\d)([A-Z]\S)/$1 $2/g; 5450 # add TagID to description 5451 $desc .= ' ' . $tagID if defined $tagID; 5452 return $desc; 5453} 5454 5455#------------------------------------------------------------------------------ 5456# Get descriptions for all tags in an array 5457# Inputs: 0) ExifTool ref, 1) reference to list of tag keys 5458# Returns: reference to hash lookup for descriptions 5459# Note: Returned descriptions are NOT escaped by ESCAPE_PROC 5460sub GetDescriptions($$) 5461{ 5462 local $_; 5463 my ($self, $tags) = @_; 5464 my %desc; 5465 my $oldEscape = $$self{ESCAPE_PROC}; 5466 delete $$self{ESCAPE_PROC}; 5467 $desc{$_} = $self->GetDescription($_) foreach @$tags; 5468 $$self{ESCAPE_PROC} = $oldEscape; 5469 return \%desc; 5470} 5471 5472#------------------------------------------------------------------------------ 5473# Apply filter to value(s) if necessary 5474# Inputs: 0) ExifTool ref, 1) filter expression, 2) reference to value to filter 5475# Returns: true unless a filter returned undef; changes value if necessary 5476sub Filter($$$) 5477{ 5478 local $_; 5479 my ($self, $filter, $valPt) = @_; 5480 return 1 unless defined $filter and defined $$valPt; 5481 my $rtnVal; 5482 if (not ref $$valPt) { 5483 $_ = $$valPt; 5484 #### eval Filter ($_, $self) 5485 eval $filter; 5486 if (defined $_) { 5487 $$valPt = $_; 5488 $rtnVal = 1; 5489 } 5490 } elsif (ref $$valPt eq 'SCALAR') { 5491 my $val = $$$valPt; # make a copy to avoid filtering twice 5492 $rtnVal = $self->Filter($filter, \$val); 5493 $$valPt = \$val; 5494 } elsif (ref $$valPt eq 'ARRAY') { 5495 my @val = @{$$valPt}; # make a copy to avoid filtering twice 5496 $self->Filter($filter, \$_) and $rtnVal = 1 foreach @val; 5497 $$valPt = \@val; 5498 } elsif (ref $$valPt eq 'HASH') { 5499 my %val = %{$$valPt}; # make a copy to avoid filtering twice 5500 $self->Filter($filter, \$val{$_}) and $rtnVal = 1 foreach keys %val; 5501 $$valPt = \%val; 5502 } else { 5503 $rtnVal = 1; 5504 } 5505 return $rtnVal; 5506} 5507 5508#------------------------------------------------------------------------------ 5509# Return printable value 5510# Inputs: 0) ExifTool object reference 5511# 1) value to print, 2) line length limit (undef defaults to 60, 0=unlimited) 5512sub Printable($;$) 5513{ 5514 my ($self, $outStr, $maxLen) = @_; 5515 return '(undef)' unless defined $outStr; 5516 $outStr =~ tr/\x01-\x1f\x7f-\xff/./; 5517 $outStr =~ s/\x00//g; 5518 my $verbose = $$self{OPTIONS}{Verbose}; 5519 if ($verbose < 4) { 5520 if ($maxLen) { 5521 $maxLen = 20 if $maxLen < 20; # minimum length is 20 5522 } elsif (defined $maxLen) { 5523 $maxLen = length $outStr; # 0 is unlimited 5524 } else { 5525 $maxLen = 60; # default maximum is 60 5526 } 5527 } else { 5528 $maxLen = length $outStr; 5529 # limit to 2048 characters if verbose < 5 5530 $maxLen = 2048 if $maxLen > 2048 and $verbose < 5; 5531 } 5532 5533 # limit length if necessary 5534 $outStr = substr($outStr,0,$maxLen-6) . '[snip]' if length($outStr) > $maxLen; 5535 return $outStr; 5536} 5537 5538#------------------------------------------------------------------------------ 5539# Convert date/time from Exif format 5540# Inputs: 0) ExifTool object reference, 1) Date/time in EXIF format 5541# Returns: Formatted date/time string 5542sub ConvertDateTime($$) 5543{ 5544 my ($self, $date) = @_; 5545 my $fmt = $$self{OPTIONS}{DateFormat}; 5546 my $shift = $$self{OPTIONS}{GlobalTimeShift}; 5547 if ($shift) { 5548 my $dir = ($shift =~ s/^([-+])// and $1 eq '-') ? -1 : 1; 5549 my $offset = $$self{GLOBAL_TIME_OFFSET}; 5550 $offset or $offset = $$self{GLOBAL_TIME_OFFSET} = { }; 5551 ShiftTime($date, $shift, $dir, $offset); 5552 } 5553 # only convert date if a format was specified and the date is recognizable 5554 if ($fmt) { 5555 # separate time zone if it exists 5556 my $tz; 5557 $date =~ s/([-+]\d{2}:\d{2}|Z)$// and $tz = $1; 5558 # a few cameras use incorrect date/time formatting: 5559 # - slashes instead of colons in date (RolleiD330, ImpressCam) 5560 # - date/time values separated by colon instead of space (Polariod, Sanyo, Sharp, Vivitar) 5561 # - single-digit seconds with leading space (HP scanners) 5562 my @a = reverse ($date =~ /\d+/g); # be very flexible about date/time format 5563 if (@a and $a[-1] >= 1000 and $a[-1] < 3000 and eval { require POSIX }) { 5564 shift @a while @a > 6; # remove superfluous entries 5565 unshift @a, 1 while @a < 3; # add month and day if necessary 5566 unshift @a, 0 while @a < 6; # add h,m,s if necessary 5567 $a[4] -= 1; # base month is 1 5568 # parse %z and %s ourself (to handle time zones properly) 5569 if ($fmt =~ /%[sz]/) { 5570 # use system time zone unless otherwise specified 5571 $tz = TimeZoneString(\@a, TimeLocal(@a)) if not $tz and eval { require Time::Local }; 5572 # remove colon, setting to UTC if time zone is not numeric 5573 $tz = ($tz and $tz=~/^([-+]\d{2}):(\d{2})$/) ? "$1$2" : '+0000'; 5574 $fmt =~ s/(^|[^%])((%%)*)%z/$1$2$tz/g; # convert '%z' format codes 5575 if ($fmt =~ /%s/ and eval { require Time::Local }) { 5576 # calculate seconds since the Epoch, UTC 5577 my $s = Time::Local::timegm(@a) - 60 * ($tz - int($tz/100) * 40); 5578 $fmt =~ s/(^|[^%])((%%)*)%s/$1$2$s/g; # convert '%s' format codes 5579 } 5580 } 5581 $a[5] -= 1900; # strftime year starts from 1900 5582 $date = POSIX::strftime($fmt, @a); # generate the formatted date/time 5583 } elsif ($$self{OPTIONS}{StrictDate}) { 5584 undef $date; 5585 } 5586 } 5587 return $date; 5588} 5589 5590#------------------------------------------------------------------------------ 5591# Print conversion for time span value 5592# Inputs: 0) time ticks, 1) number of seconds per tick (default 1) 5593# Returns: readable time 5594sub ConvertTimeSpan($;$) 5595{ 5596 my ($val, $mult) = @_; 5597 if (Image::ExifTool::IsFloat($val) and $val != 0) { 5598 $val *= $mult if $mult; 5599 if ($val < 60) { 5600 $val = "$val seconds"; 5601 } elsif ($val < 3600) { 5602 my $fmt = ($mult and $mult >= 60) ? '%d' : '%.1f'; 5603 my $s = ($val == 60 and $mult) ? '' : 's'; 5604 $val = sprintf("$fmt minute$s", $val / 60); 5605 } elsif ($val < 24 * 3600) { 5606 $val = sprintf("%.1f hours", $val / 3600); 5607 } else { 5608 $val = sprintf("%.1f days", $val / (24 * 3600)); 5609 } 5610 } 5611 return $val; 5612} 5613 5614#------------------------------------------------------------------------------ 5615# Patched timelocal() that fixes ActivePerl timezone bug 5616# Inputs/Returns: same as timelocal() 5617# Notes: must 'require Time::Local' before calling this routine 5618sub TimeLocal(@) 5619{ 5620 my $tm = Time::Local::timelocal(@_); 5621 if ($^O eq 'MSWin32') { 5622 # patch for ActivePerl timezone bug 5623 my @t2 = localtime($tm); 5624 my $t2 = Time::Local::timelocal(@t2); 5625 # adjust timelocal() return value to be consistent with localtime() 5626 $tm += $tm - $t2; 5627 } 5628 return $tm; 5629} 5630 5631#------------------------------------------------------------------------------ 5632# Get time zone in minutes 5633# Inputs: 0) localtime array ref, 1) gmtime array ref 5634# Returns: time zone offset in minutes 5635sub GetTimeZone($$) 5636{ 5637 my ($tm, $gm) = @_; 5638 # compute the number of minutes between localtime and gmtime 5639 my $min = $$tm[2] * 60 + $$tm[1] - ($$gm[2] * 60 + $$gm[1]); 5640 if ($$tm[3] != $$gm[3]) { 5641 # account for case where one date wraps to the first of the next month 5642 $$gm[3] = $$tm[3] - ($$tm[3]==1 ? 1 : -1) if abs($$tm[3]-$$gm[3]) != 1; 5643 # adjust for the +/- one day difference 5644 $min += ($$tm[3] - $$gm[3]) * 24 * 60; 5645 } 5646 # MirBSD patch to round to the nearest 30 minutes because 5647 # it includes leap seconds in localtime but not gmtime 5648 $min = int($min / 30 + ($min > 0 ? 0.5 : -0.5)) * 30 if $^O eq 'mirbsd'; 5649 return $min; 5650} 5651 5652#------------------------------------------------------------------------------ 5653# Get time zone string 5654# Inputs: 0) time zone offset in minutes 5655# or 0) localtime array ref, 1) corresponding time value 5656# Returns: time zone string ("+/-HH:MM") 5657sub TimeZoneString($;$) 5658{ 5659 my $min = shift; 5660 if (ref $min) { 5661 my @gm = gmtime(shift); 5662 $min = GetTimeZone($min, \@gm); 5663 } 5664 my $sign = '+'; 5665 $min < 0 and $sign = '-', $min = -$min; 5666 $min = int($min + 0.5); # round off to nearest minute 5667 my $h = int($min / 60); 5668 return sprintf('%s%.2d:%.2d', $sign, $h, $min - $h * 60); 5669} 5670 5671#------------------------------------------------------------------------------ 5672# Convert Unix time to EXIF date/time string 5673# Inputs: 0) Unix time value, 1) non-zero to convert to local time, 5674# 2) number of digits after the decimal for fractional seconds 5675# Returns: EXIF date/time string (with timezone for local times) 5676sub ConvertUnixTime($;$$) 5677{ 5678 my ($time, $toLocal, $dec) = @_; 5679 return '0000:00:00 00:00:00' if $time == 0; 5680 my (@tm, $tz); 5681 if ($dec) { 5682 my $frac = $time - int($time); 5683 $time = int($time); 5684 $frac < 0 and $frac += 1, $time -= 1; 5685 $dec = sprintf('%.*f', $dec, $frac); 5686 # remove number before decimal and increment integer time if it was rounded up 5687 $dec =~ s/^(\d)// and $1 eq '1' and $time += 1; 5688 } else { 5689 $time = int($time + 1e-6) if $time != int($time); # avoid round-off errors 5690 $dec = ''; 5691 } 5692 if ($toLocal) { 5693 @tm = localtime($time); 5694 $tz = TimeZoneString(\@tm, $time); 5695 } else { 5696 @tm = gmtime($time); 5697 $tz = ''; 5698 } 5699 my $str = sprintf("%4d:%.2d:%.2d %.2d:%.2d:%.2d$dec%s", 5700 $tm[5]+1900, $tm[4]+1, $tm[3], $tm[2], $tm[1], $tm[0], $tz); 5701 return $str; 5702} 5703 5704#------------------------------------------------------------------------------ 5705# Get Unix time from EXIF-formatted date/time string with optional timezone 5706# Inputs: 0) EXIF date/time string, 1) non-zero if time is local, or 2 to assume UTC 5707# Returns: Unix time (seconds since 0:00 GMT Jan 1, 1970) or undefined on error 5708sub GetUnixTime($;$) 5709{ 5710 my ($timeStr, $isLocal) = @_; 5711 return 0 if $timeStr eq '0000:00:00 00:00:00'; 5712 my @tm = ($timeStr =~ /^(\d+):(\d+):(\d+)\s+(\d+):(\d+):(\d+)(.*)/); 5713 return undef unless @tm == 7 and eval { require Time::Local }; 5714 my ($tzStr, $tzSec) = (pop(@tm), 0); 5715 # use specified timezone offset (if given) instead of local system time 5716 # if we are converting a local time value 5717 if ($isLocal) { 5718 if ($tzStr =~ /(?:Z|([-+])(\d+):(\d+))/i) { 5719 # use specified timezone if one exists 5720 $tzSec = ($2 * 60 + $3) * ($1 eq '-' ? -60 : 60) if $1; 5721 undef $isLocal; # convert using GMT corrected for specified timezone 5722 } elsif ($isLocal eq '2') { 5723 undef $isLocal; 5724 } 5725 } 5726 $tm[1] -= 1; # convert month 5727 @tm = reverse @tm; # change to order required by timelocal() 5728 my $val = $isLocal ? TimeLocal(@tm) : Time::Local::timegm(@tm) - $tzSec; 5729 # handle fractional seconds 5730 $val += $1 if $tzStr and $tzStr =~ /^(\.\d+)/; 5731 return $val; 5732} 5733 5734#------------------------------------------------------------------------------ 5735# Print conversion for file size 5736# Inputs: 0) file size in bytes 5737# Returns: converted file size 5738sub ConvertFileSize($) 5739{ 5740 my $val = shift; 5741 $val < 2048 and return "$val bytes"; 5742 $val < 10240 and return sprintf('%.1f KiB', $val / 1024); 5743 $val < 2097152 and return sprintf('%.0f KiB', $val / 1024); 5744 $val < 10485760 and return sprintf('%.1f MiB', $val / 1048576); 5745 $val < 2147483648 and return sprintf('%.0f MiB', $val / 1048576); 5746 $val < 10737418240 and return sprintf('%.1f GiB', $val / 1073741824); 5747 return sprintf('%.0f GiB', $val / 1073741824); 5748} 5749 5750#------------------------------------------------------------------------------ 5751# Convert seconds to duration string (handles negative durations) 5752# Inputs: 0) floating point seconds 5753# Returns: duration string in form "S.SS s", "H:MM:SS" or "DD days HH:MM:SS" 5754sub ConvertDuration($) 5755{ 5756 my $time = shift; 5757 return $time unless IsFloat($time); 5758 return '0 s' if $time == 0; 5759 my $sign = ($time > 0 ? '' : (($time = -$time), '-')); 5760 return sprintf("$sign%.2f s", $time) if $time < 30; 5761 $time += 0.5; # to round off to nearest second 5762 my $h = int($time / 3600); 5763 $time -= $h * 3600; 5764 my $m = int($time / 60); 5765 $time -= $m * 60; 5766 if ($h > 24) { 5767 my $d = int($h / 24); 5768 $h -= $d * 24; 5769 $sign = "$sign$d days "; 5770 } 5771 return sprintf("$sign%d:%.2d:%.2d", $h, $m, int($time)); 5772} 5773 5774#------------------------------------------------------------------------------ 5775# Print conversion for bitrate values 5776# Inputs: 0) bitrate in bits per second 5777# Returns: human-readable bitrate string 5778# Notes: returns input value without formatting if it isn't numerical 5779sub ConvertBitrate($) 5780{ 5781 my $bitrate = shift; 5782 IsFloat($bitrate) or return $bitrate; 5783 my @units = ('bps', 'kbps', 'Mbps', 'Gbps'); 5784 for (;;) { 5785 my $units = shift @units; 5786 $bitrate >= 1000 and @units and $bitrate /= 1000, next; 5787 my $fmt = $bitrate < 100 ? '%.3g' : '%.0f'; 5788 return sprintf("$fmt $units", $bitrate); 5789 } 5790} 5791 5792#------------------------------------------------------------------------------ 5793# Convert file name for printing 5794# Inputs: 0) ExifTool ref, 1) file name in CharsetFileName character set 5795# Returns: converted file name in external character set 5796sub ConvertFileName($$) 5797{ 5798 my ($self, $val) = @_; 5799 my $enc = $$self{OPTIONS}{CharsetFileName}; 5800 $val = $self->Decode($val, $enc) if $enc; 5801 return $val; 5802} 5803 5804#------------------------------------------------------------------------------ 5805# Inverse conversion for file name (encode in CharsetFileName) 5806# Inputs: 0) ExifTool ref, 1) file name in external character set 5807# Returns: file name in CharsetFileName character set 5808sub InverseFileName($$) 5809{ 5810 my ($self, $val) = @_; 5811 my $enc = $$self{OPTIONS}{CharsetFileName}; 5812 $val = $self->Encode($val, $enc) if $enc; 5813 $val =~ tr/\\/\//; # make sure we are using forward slashes 5814 return $val; 5815} 5816 5817#------------------------------------------------------------------------------ 5818# Save information for HTML dump 5819# Inputs: 0) ExifTool hash ref, 1) start offset, 2) data size 5820# 3) comment string, 4) tool tip (or SAME), 5) flags, 6) IFD name 5821sub HDump($$$$;$$$) 5822{ 5823 my $self = shift; 5824 $$self{HTML_DUMP} or return; 5825 my ($pos, $len, $com, $tip, $flg, $ifd) = @_; 5826 $pos += $$self{BASE} if $$self{BASE}; 5827 # skip structural data blocks which have been removed from the middle of this dump 5828 # (SkipData list contains ordered [start,end+1] offsets to skip) 5829 if ($$self{SkipData}) { 5830 my $end = $pos + $len; 5831 my $skip; 5832 foreach $skip (@{$$self{SkipData}}) { 5833 $end <= $$skip[0] and last; 5834 $pos >= $$skip[1] and $pos += $$skip[1] - $$skip[0], next; 5835 if ($pos != $$skip[0]) { 5836 $$self{HTML_DUMP}->Add($pos, $$skip[0]-$pos, $com, $tip, $flg, $ifd); 5837 $len -= $$skip[0] - $pos; 5838 $tip = 'SAME'; 5839 } 5840 $pos = $$skip[1]; 5841 } 5842 } 5843 $$self{HTML_DUMP}->Add($pos, $len, $com, $tip, $flg, $ifd); 5844} 5845 5846#------------------------------------------------------------------------------ 5847# Identify trailer ending at specified offset from end of file 5848# Inputs: 0) RAF reference, 1) offset from end of file (0 by default) 5849# Returns: Trailer info hash (with RAF and DirName set), 5850# or undef if no recognized trailer was found 5851# Notes: leaves file position unchanged 5852sub IdentifyTrailer($;$) 5853{ 5854 my $raf = shift; 5855 my $offset = shift || 0; 5856 my $pos = $raf->Tell(); 5857 my ($buff, $type, $len); 5858 while ($raf->Seek(-$offset, 2) and ($len = $raf->Tell()) > 0) { 5859 # read up to 64 bytes before specified offset from end of file 5860 $len = 64 if $len > 64; 5861 $raf->Seek(-$len, 1) and $raf->Read($buff, $len) == $len or last; 5862 if ($buff =~ /AXS(!|\*).{8}$/s) { 5863 $type = 'AFCP'; 5864 } elsif ($buff =~ /\xa1\xb2\xc3\xd4$/) { 5865 $type = 'FotoStation'; 5866 } elsif ($buff =~ /cbipcbbl$/) { 5867 $type = 'PhotoMechanic'; 5868 } elsif ($buff =~ /^CANON OPTIONAL DATA\0/) { 5869 $type = 'CanonVRD'; 5870 } elsif ($buff =~ /~\0\x04\0zmie~\0\0\x06.{4}[\x10\x18]\x04$/s or 5871 $buff =~ /~\0\x04\0zmie~\0\0\x0a.{8}[\x10\x18]\x08$/s) 5872 { 5873 $type = 'MIE'; 5874 } elsif ($buff =~ /\0\0(QDIOBS|SEFT)$/) { 5875 $type = 'Samsung'; 5876 } elsif ($buff =~ /8db42d694ccc418790edff439fe026bf$/s) { 5877 $type = 'Insta360'; 5878 } 5879 last; 5880 } 5881 $raf->Seek($pos, 0); # restore original file position 5882 return $type ? { RAF => $raf, DirName => $type } : undef; 5883} 5884 5885#------------------------------------------------------------------------------ 5886# Read/rewrite trailer information (including multiple trailers) 5887# Inputs: 0) ExifTool object ref, 1) DirInfo ref: 5888# - requires RAF and DirName 5889# - OutFile is a scalar reference for writing 5890# - scans from current file position if ScanForAFCP is set 5891# Returns: 1 if trailer was processed or couldn't be processed (or written OK) 5892# 0 if trailer was recognized but offsets need fixing (or write error) 5893# - DirName, DirLen, DataPos, Offset, Fixup and OutFile are updated 5894# - preserves current file position and byte order 5895sub ProcessTrailers($$) 5896{ 5897 my ($self, $dirInfo) = @_; 5898 my $dirName = $$dirInfo{DirName}; 5899 my $outfile = $$dirInfo{OutFile}; 5900 my $offset = $$dirInfo{Offset} || 0; 5901 my $fixup = $$dirInfo{Fixup}; 5902 my $raf = $$dirInfo{RAF}; 5903 my $pos = $raf->Tell(); 5904 my $byteOrder = GetByteOrder(); 5905 my $success = 1; 5906 my $path = $$self{PATH}; 5907 5908 for (;;) { # loop through all trailers 5909 my ($proc, $outBuff); 5910 if ($dirName eq 'Insta360') { 5911 require "Image/ExifTool/QuickTimeStream.pl"; 5912 $proc = 'Image::ExifTool::QuickTime::ProcessInsta360'; 5913 } else { 5914 require "Image/ExifTool/$dirName.pm"; 5915 $proc = "Image::ExifTool::${dirName}::Process$dirName"; 5916 } 5917 if ($outfile) { 5918 # write to local buffer so we can add trailer in proper order later 5919 $$outfile and $$dirInfo{OutFile} = \$outBuff, $outBuff = ''; 5920 # must generate new fixup if necessary so we can shift 5921 # the old fixup separately after we prepend this trailer 5922 delete $$dirInfo{Fixup}; 5923 } 5924 delete $$dirInfo{DirLen}; # reset trailer length 5925 $$dirInfo{Offset} = $offset; # set offset from end of file 5926 $$dirInfo{Trailer} = 1; # set Trailer flag in case proc cares 5927 # add trailer and DirName to SubDirectory PATH 5928 push @$path, 'Trailer', $dirName; 5929 5930 # read or write this trailer 5931 # (proc takes Offset as positive offset from end of trailer to end of file, 5932 # and returns DataPos and DirLen, and Fixup if applicable, and updates 5933 # OutFile when writing) 5934 no strict 'refs'; 5935 my $result = &$proc($self, $dirInfo); 5936 use strict 'refs'; 5937 5938 # restore PATH (pop last 2 items) 5939 splice @$path, -2; 5940 5941 # check result 5942 if ($outfile) { 5943 if ($result > 0) { 5944 if ($outBuff) { 5945 # write trailers to OutFile in original order 5946 $$outfile = $outBuff . $$outfile; 5947 # must adjust old fixup start if it exists 5948 $$fixup{Start} += length($outBuff) if $fixup; 5949 $outBuff = ''; # free memory 5950 } 5951 if ($$dirInfo{Fixup}) { 5952 if ($fixup) { 5953 # add fixup for subsequent trailers to the fixup for this trailer 5954 # (but first we must adjust for the new start position) 5955 $$fixup{Shift} += $$dirInfo{Fixup}{Start}; 5956 $$fixup{Start} -= $$dirInfo{Fixup}{Start}; 5957 $$dirInfo{Fixup}->AddFixup($fixup); 5958 } 5959 $fixup = $$dirInfo{Fixup}; # save fixup 5960 } 5961 } else { 5962 $success = 0 if $self->Error("Error rewriting $dirName trailer", 2); 5963 last; 5964 } 5965 } elsif ($result < 0) { 5966 # can't continue if we must scan for this trailer 5967 $success = 0; 5968 last; 5969 } 5970 last unless $result > 0 and $$dirInfo{DirLen}; 5971 # look for next trailer 5972 $offset += $$dirInfo{DirLen}; 5973 my $nextTrail = IdentifyTrailer($raf, $offset) or last; 5974 $dirName = $$dirInfo{DirName} = $$nextTrail{DirName}; 5975 $raf->Seek($pos, 0); 5976 } 5977 SetByteOrder($byteOrder); # restore original byte order 5978 $raf->Seek($pos, 0); # restore original file position 5979 $$dirInfo{OutFile} = $outfile; # restore original outfile 5980 $$dirInfo{Offset} = $offset; # return offset from EOF to start of first trailer 5981 $$dirInfo{Fixup} = $fixup; # return fixup information 5982 return $success; 5983} 5984 5985#------------------------------------------------------------------------------ 5986# JPEG constants 5987 5988# JPEG marker names 5989%jpegMarker = ( 5990 0x00 => 'NULL', 5991 0x01 => 'TEM', 5992 0xc0 => 'SOF0', # to SOF15, with a few exceptions below 5993 0xc4 => 'DHT', 5994 0xc8 => 'JPGA', 5995 0xcc => 'DAC', 5996 0xd0 => 'RST0', # to RST7 5997 0xd8 => 'SOI', 5998 0xd9 => 'EOI', 5999 0xda => 'SOS', 6000 0xdb => 'DQT', 6001 0xdc => 'DNL', 6002 0xdd => 'DRI', 6003 0xde => 'DHP', 6004 0xdf => 'EXP', 6005 0xe0 => 'APP0', # to APP15 6006 0xf0 => 'JPG0', 6007 0xfe => 'COM', 6008); 6009 6010# lookup for size of JPEG marker length word 6011# (2 bytes assumed unless specified here) 6012my %markerLenBytes = ( 6013 0x00 => 0, 0x01 => 0, 6014 0xd0 => 0, 0xd1 => 0, 0xd2 => 0, 0xd3 => 0, 0xd4 => 0, 0xd5 => 0, 0xd6 => 0, 0xd7 => 0, 6015 0xd8 => 0, 0xd9 => 0, 0xda => 0, 6016 # J2C 6017 0x30 => 0, 0x31 => 0, 0x32 => 0, 0x33 => 0, 0x34 => 0, 0x35 => 0, 0x36 => 0, 0x37 => 0, 6018 0x38 => 0, 0x39 => 0, 0x3a => 0, 0x3b => 0, 0x3c => 0, 0x3d => 0, 0x3e => 0, 0x3f => 0, 6019 0x4f => 0, 6020 0x92 => 0, 0x93 => 0, 6021 # J2C extensions 6022 0x74 => 4, 0x75 => 4, 0x77 => 4, 6023); 6024 6025#------------------------------------------------------------------------------ 6026# Get JPEG marker name 6027# Inputs: 0) Jpeg number 6028# Returns: marker name 6029sub JpegMarkerName($) 6030{ 6031 my $marker = shift; 6032 my $markerName = $jpegMarker{$marker}; 6033 unless ($markerName) { 6034 $markerName = $jpegMarker{$marker & 0xf0}; 6035 if ($markerName and $markerName =~ /^([A-Z]+)\d+$/) { 6036 $markerName = $1 . ($marker & 0x0f); 6037 } else { 6038 $markerName = sprintf("marker 0x%.2x", $marker); 6039 } 6040 } 6041 return $markerName; 6042} 6043 6044#------------------------------------------------------------------------------ 6045# Adjust directory start position 6046# Inputs: 0) dirInfo ref, 1) start offset 6047# 2) Base for offsets (relative to DataPos, defaults to absolute Base of 0) 6048sub DirStart($$;$) 6049{ 6050 my ($dirInfo, $start, $base) = @_; 6051 $$dirInfo{DirStart} = $start; 6052 $$dirInfo{DirLen} -= $start; 6053 if (defined $base) { 6054 $$dirInfo{Base} = $$dirInfo{DataPos} + $base; 6055 $$dirInfo{DataPos} = -$base; # (relative to Base!) 6056 } 6057} 6058 6059#------------------------------------------------------------------------------ 6060# Extract metadata from a jpg image 6061# Inputs: 0) ExifTool object reference, 1) dirInfo ref with RAF set 6062# Returns: 1 on success, 0 if this wasn't a valid JPEG file 6063sub ProcessJPEG($$) 6064{ 6065 local $_; 6066 my ($self, $dirInfo) = @_; 6067 my ($ch, $s, $length); 6068 my $options = $$self{OPTIONS}; 6069 my $verbose = $$options{Verbose}; 6070 my $out = $$options{TextOut}; 6071 my $fast = $$options{FastScan} || 0; 6072 my $raf = $$dirInfo{RAF}; 6073 my $htmlDump = $$self{HTML_DUMP}; 6074 my %dumpParms = ( Out => $out ); 6075 my ($success, $wantTrailer, $trailInfo, $foundSOS); 6076 my (@iccChunk, $iccChunkCount, $iccChunksTotal, @flirChunk, $flirCount, $flirTotal); 6077 my ($preview, $scalado, @dqt, $subSampling, $dumpEnd, %extendedXMP); 6078 6079 # check to be sure this is a valid JPG (or J2C, or EXV) file 6080 return 0 unless $raf->Read($s, 2) == 2 and $s =~ /^\xff[\xd8\x4f\x01]/; 6081 if ($s eq "\xff\x01") { 6082 return 0 unless $raf->Read($s, 5) == 5 and $s eq 'Exiv2'; 6083 $$self{FILE_TYPE} = 'EXV'; 6084 } 6085 my $appBytes = 0; 6086 my $calcImageLen = $$self{REQ_TAG_LOOKUP}{jpegimagelength}; 6087 if ($$options{RequestAll} and $$options{RequestAll} > 2) { 6088 $calcImageLen = 1; 6089 } 6090 if (not $$self{VALUE}{FileType} or ($$self{DOC_NUM} and $$options{ExtractEmbedded})) { 6091 $self->SetFileType(); # set FileType tag 6092 return 1 if $fast == 3; # don't process file when FastScan == 3 6093 $$self{LOW_PRIORITY_DIR}{IFD1} = 1; # lower priority of IFD1 tags 6094 } 6095 $$raf{NoBuffer} = 1 if $self->Options('FastScan'); # disable buffering in FastScan mode 6096 6097 $dumpParms{MaxLen} = 128 if $verbose < 4; 6098 if ($htmlDump) { 6099 $dumpEnd = $raf->Tell(); 6100 my ($n, $t, $m) = $s eq 'Exiv2' ? (7,'EXV','TEM') : (2,'JPEG','SOI'); 6101 my $pos = $dumpEnd - $n; 6102 $self->HDump(0, $pos, '[unknown header]') if $pos; 6103 $self->HDump($pos, $n, "$t header", "$m Marker"); 6104 } 6105 my $path = $$self{PATH}; 6106 my $pn = scalar @$path; 6107 6108 # set input record separator to 0xff (the JPEG marker) to make reading quicker 6109 local $/ = "\xff"; 6110 6111 my ($nextMarker, $nextSegDataPt, $nextSegPos, $combinedSegData, $firstSegPos, @skipData); 6112 6113 # read file until we reach an end of image (EOI) or start of scan (SOS) 6114 Marker: for (;;) { 6115 # set marker and data pointer for current segment 6116 my $marker = $nextMarker; 6117 my $segDataPt = $nextSegDataPt; 6118 my $segPos = $nextSegPos; 6119 undef $nextMarker; 6120 undef $nextSegDataPt; 6121# 6122# read ahead to the next segment unless we have reached EOI, SOS or SOD 6123# 6124 unless ($marker and ($marker==0xd9 or ($marker==0xda and not $wantTrailer) or $marker==0x93)) { 6125 # read up to next marker (JPEG markers begin with 0xff) 6126 my $buff; 6127 $raf->ReadLine($buff) or last; 6128 # JPEG markers can be padded with unlimited 0xff's 6129 for (;;) { 6130 $raf->Read($ch, 1) or last Marker; 6131 $nextMarker = ord($ch); 6132 last unless $nextMarker == 0xff; 6133 } 6134 # read segment data if it exists 6135 if (not defined $markerLenBytes{$nextMarker}) { 6136 # read record length word 6137 last unless $raf->Read($s, 2) == 2; 6138 my $len = unpack('n',$s); # get data length 6139 last unless defined($len) and $len >= 2; 6140 $nextSegPos = $raf->Tell(); 6141 $len -= 2; # subtract size of length word 6142 last unless $raf->Read($buff, $len) == $len; 6143 $nextSegDataPt = \$buff; # set pointer to our next data 6144 } elsif ($markerLenBytes{$nextMarker} == 4) { 6145 # handle J2C extensions with 4-byte length word 6146 last unless $raf->Read($s, 4) == 4; 6147 my $len = unpack('N',$s); # get data length 6148 last unless defined($len) and $len >= 4; 6149 $nextSegPos = $raf->Tell(); 6150 $len -= 4; # subtract size of length word 6151 last unless $raf->Seek($len, 1); 6152 } 6153 # read second segment too if this was the first 6154 next unless defined $marker; 6155 } 6156 # set some useful variables for the current segment 6157 my $markerName = JpegMarkerName($marker); 6158 $$path[$pn] = $markerName; 6159# 6160# parse the current segment 6161# 6162 # handle SOF markers: SOF0-SOF15, except DHT(0xc4), JPGA(0xc8) and DAC(0xcc) 6163 if (($marker & 0xf0) == 0xc0 and ($marker == 0xc0 or $marker & 0x03)) { 6164 $length = length $$segDataPt; 6165 if ($verbose) { 6166 print $out "JPEG $markerName ($length bytes):\n"; 6167 HexDump($segDataPt, undef, %dumpParms, Addr=>$segPos) if $verbose>2; 6168 } elsif ($htmlDump) { 6169 $self->HDump($segPos-4, $length+4, "[JPEG $markerName]", undef, 0x08); 6170 $dumpEnd = $segPos + $length; 6171 } 6172 next unless $length >= 6; 6173 # extract some useful information 6174 my ($p, $h, $w, $n) = unpack('Cn2C', $$segDataPt); 6175 my $sof = GetTagTable('Image::ExifTool::JPEG::SOF'); 6176 $self->HandleTag($sof, 'ImageWidth', $w); 6177 $self->HandleTag($sof, 'ImageHeight', $h); 6178 $self->HandleTag($sof, 'EncodingProcess', $marker - 0xc0); 6179 $self->HandleTag($sof, 'BitsPerSample', $p); 6180 $self->HandleTag($sof, 'ColorComponents', $n); 6181 next unless $n == 3 and $length >= 15; 6182 my ($i, $hmin, $hmax, $vmin, $vmax); 6183 # loop through all components to determine sampling frequency 6184 $subSampling = ''; 6185 for ($i=0; $i<$n; ++$i) { 6186 my $sf = Get8u($segDataPt, 7 + 3 * $i); 6187 $subSampling .= sprintf('%.2x', $sf); 6188 # isolate horizontal and vertical components 6189 my ($hf, $vf) = ($sf >> 4, $sf & 0x0f); 6190 unless ($i) { 6191 $hmin = $hmax = $hf; 6192 $vmin = $vmax = $vf; 6193 next; 6194 } 6195 # determine min/max frequencies 6196 $hmin = $hf if $hf < $hmin; 6197 $hmax = $hf if $hf > $hmax; 6198 $vmin = $vf if $vf < $vmin; 6199 $vmax = $vf if $vf > $vmax; 6200 } 6201 if ($hmin and $vmin) { 6202 my ($hs, $vs) = ($hmax / $hmin, $vmax / $vmin); 6203 $self->HandleTag($sof, 'YCbCrSubSampling', "$hs $vs"); 6204 } 6205 next; 6206 } elsif ($marker == 0xd9) { # EOI 6207 pop @$path; 6208 $verbose and print $out "JPEG EOI\n"; 6209 my $pos = $raf->Tell(); 6210 if ($htmlDump and $dumpEnd) { 6211 $self->HDump($dumpEnd, $pos-2-$dumpEnd, '[JPEG Image Data]', undef, 0x08); 6212 $self->HDump($pos-2, 2, 'JPEG EOI', undef); 6213 $dumpEnd = 0; 6214 } 6215 if ($foundSOS or $$self{FILE_TYPE} eq 'EXV') { 6216 $success = 1; 6217 } else { 6218 $self->Warn('Missing JPEG SOS'); 6219 } 6220 if ($$self{REQ_TAG_LOOKUP}{trailer}) { 6221 # read entire trailer into memory 6222 if ($raf->Seek(0,2)) { 6223 my $len = $raf->Tell() - $pos; 6224 if ($len) { 6225 my $buff; 6226 $raf->Seek($pos, 0); 6227 $self->FoundTag(Trailer => \$buff) if $raf->Read($buff,$len) == $len; 6228 $raf->Seek($pos, 0); 6229 } 6230 } else { 6231 $self->Warn('Error seeking in file'); 6232 } 6233 } 6234 # we are here because we are looking for trailer information 6235 if ($wantTrailer) { 6236 my $start = $$self{PreviewImageStart}; 6237 if ($start or $$options{ExtractEmbedded}) { 6238 my $buff; 6239 # most previews start right after the JPEG EOI, but the Olympus E-20 6240 # preview is 508 bytes into the trailer, the K-M Maxxum 7D preview is 6241 # 979 bytes in, and Sony previews can start up to 32 kB into the trailer. 6242 # (and Minolta and Sony previews can have a random first byte...) 6243 my $scanLen = $$self{Make} =~ /Sony/i ? 65536 : 1024; 6244 if ($raf->Read($buff, $scanLen)) { 6245 if ($buff =~ /^.{4}ftyp/s) { 6246 my $val; 6247 if ($raf->Seek(0,2)) { 6248 my $len = $raf->Tell() - $pos; 6249 if ($$options{Binary}) { 6250 $val = \$buff if $raf->Seek($pos,0) and $raf->Read($buff,$len)==$len; 6251 } else { 6252 $val = \ "Binary data $len bytes"; 6253 } 6254 if ($val) { 6255 $self->FoundTag('EmbeddedVideo', $val); 6256 } else { 6257 $self->Warn('Error reading trailer'); 6258 } 6259 } else { 6260 $self->Warn('Error seeking to end of file'); 6261 } 6262 } elsif ($buff =~ /\xff\xd8\xff./g or 6263 ($$self{Make} =~ /(Minolta|Sony)/i and $buff =~ /.\xd8\xff\xdb/g)) 6264 { 6265 # adjust PreviewImageStart to this location 6266 my $actual = $pos + pos($buff) - 4; 6267 if ($start and $start ne $actual and $verbose > 1) { 6268 print $out "(Fixed PreviewImage location: $start -> $actual)\n"; 6269 } 6270 # update preview image offsets 6271 if ($start) { 6272 $$self{VALUE}{PreviewImageStart} = $actual if $$self{VALUE}{PreviewImageStart}; 6273 $$self{PreviewImageStart} = $actual; 6274 } 6275 # load preview now if we tried and failed earlier 6276 if ($$self{PreviewError} and $$self{PreviewImageLength}) { 6277 if ($raf->Seek($actual, 0) and $raf->Read($buff, $$self{PreviewImageLength})) { 6278 $self->FoundTag('PreviewImage', $buff); 6279 delete $$self{PreviewError}; 6280 } 6281 } 6282 } 6283 } 6284 $raf->Seek($pos, 0); 6285 } 6286 } 6287 # process trailer now or finish processing trailers 6288 # and scan for AFCP if necessary 6289 my $fromEnd = 0; 6290 if ($trailInfo) { 6291 $$trailInfo{ScanForAFCP} = 1; # scan now if necessary 6292 $self->ProcessTrailers($trailInfo); 6293 # save offset from end of file to start of first trailer 6294 $fromEnd = $$trailInfo{Offset}; 6295 undef $trailInfo; 6296 } 6297 if ($$self{LeicaTrailer}) { 6298 $raf->Seek(0, 2); 6299 $$self{LeicaTrailer}{TrailPos} = $pos; 6300 $$self{LeicaTrailer}{TrailLen} = $raf->Tell() - $pos - $fromEnd; 6301 Image::ExifTool::Panasonic::ProcessLeicaTrailer($self); 6302 } 6303 # finally, dump remaining information in JPEG trailer 6304 if ($verbose or $htmlDump) { 6305 my $endPos = $$self{LeicaTrailerPos}; 6306 unless ($endPos) { 6307 $raf->Seek(0, 2); 6308 $endPos = $raf->Tell() - $fromEnd; 6309 } 6310 $self->DumpUnknownTrailer({ 6311 RAF => $raf, 6312 DataPos => $pos, 6313 DirLen => $endPos - $pos 6314 }) if $endPos > $pos; 6315 } 6316 $self->FoundTag('JPEGImageLength', $pos - $appBytes) if $calcImageLen; 6317 last; # all done parsing file 6318 } elsif ($marker == 0xda) { # SOS 6319 pop @$path; 6320 $foundSOS = 1; 6321 # all done with meta information unless we have a trailer 6322 $verbose and print $out "JPEG SOS\n"; 6323 unless ($fast) { 6324 $trailInfo = IdentifyTrailer($raf); 6325 # process trailer now unless we are doing verbose dump 6326 if ($trailInfo and $verbose < 3 and not $htmlDump) { 6327 # process trailers (keep trailInfo to finish processing later 6328 # only if we can't finish without scanning from end of file) 6329 $self->ProcessTrailers($trailInfo) and undef $trailInfo; 6330 } 6331 if ($wantTrailer and $$self{PreviewImageStart}) { 6332 # seek ahead and validate preview image 6333 my $buff; 6334 my $curPos = $raf->Tell(); 6335 if ($raf->Seek($$self{PreviewImageStart}, 0) and 6336 $raf->Read($buff, 4) == 4 and 6337 $buff =~ /^.\xd8\xff[\xc4\xdb\xe0-\xef]/) 6338 { 6339 undef $wantTrailer; 6340 } 6341 $raf->Seek($curPos, 0) or last; 6342 } 6343 # seek ahead and process Leica trailer 6344 if ($$self{LeicaTrailer}) { 6345 require Image::ExifTool::Panasonic; 6346 Image::ExifTool::Panasonic::ProcessLeicaTrailer($self); 6347 $wantTrailer = 1 if $$self{LeicaTrailer}; 6348 } else { 6349 $wantTrailer = 1 if $$options{ExtractEmbedded}; 6350 } 6351 next if $trailInfo or $wantTrailer or $verbose > 2 or $htmlDump; 6352 } 6353 # must scan to EOI if Validate or JpegCompressionFactor used 6354 next if $$options{Validate} or $calcImageLen or $$self{REQ_TAG_LOOKUP}{trailer}; 6355 # nothing interesting to parse after start of scan (SOS) 6356 $success = 1; 6357 last; # all done parsing file 6358 } elsif ($marker == 0x93) { 6359 pop @$path; 6360 $verbose and print $out "JPEG SOD\n"; 6361 $success = 1; 6362 next if $verbose > 2 or $htmlDump; 6363 last; # all done parsing file 6364 } elsif (defined $markerLenBytes{$marker}) { 6365 # handle other stand-alone markers and segments we skipped over 6366 $verbose and $marker and print $out "JPEG $markerName\n"; 6367 next; 6368 } elsif ($marker == 0xdb and length($$segDataPt) and # DQT 6369 # save the DQT data only if JPEGDigest has been requested 6370 # (Note: since we aren't checking the RequestAll API option here, the application 6371 # must use the RequestTags option to generate these tags if they have not been 6372 # specifically requested. The reason is that there is too much overhead involved 6373 # in the calculation of this tag to make this worth the CPU time.) 6374 ($$self{REQ_TAG_LOOKUP}{jpegdigest} or $$self{REQ_TAG_LOOKUP}{jpegqualityestimate} 6375 or ($$options{RequestAll} and $$options{RequestAll} > 2))) 6376 { 6377 my $num = unpack('C',$$segDataPt) & 0x0f; # get table index 6378 $dqt[$num] = $$segDataPt if $num < 4; # save for MD5 calculation 6379 } 6380 # handle all other markers 6381 my $dumpType = ''; 6382 my ($desc, $tip, $xtra); 6383 $length = length $$segDataPt; 6384 $appBytes += $length + 4 if ($marker & 0xf0) == 0xe0; # total size of APP segments 6385 if ($verbose) { 6386 print $out "JPEG $markerName ($length bytes):\n"; 6387 if ($verbose > 2) { 6388 my %extraParms = ( Addr => $segPos ); 6389 $extraParms{MaxLen} = 128 if $verbose == 4; 6390 HexDump($segDataPt, undef, %dumpParms, %extraParms); 6391 } 6392 } 6393 # prepare dirInfo hash for processing this information 6394 my %dirInfo = ( 6395 Parent => $markerName, 6396 DataPt => $segDataPt, 6397 DataPos => $segPos, 6398 DataLen => $length, 6399 DirStart => 0, 6400 DirLen => $length, 6401 Base => 0, 6402 ); 6403 if ($marker == 0xe0) { # APP0 (JFIF, JFXX, CIFF, AVI1, Ocad) 6404 if ($$segDataPt =~ /^JFIF\0/) { 6405 $dumpType = 'JFIF'; 6406 DirStart(\%dirInfo, 5); # start at byte 5 6407 SetByteOrder('MM'); 6408 my $tagTablePtr = GetTagTable('Image::ExifTool::JFIF::Main'); 6409 $self->ProcessDirectory(\%dirInfo, $tagTablePtr); 6410 } elsif ($$segDataPt =~ /^JFXX\0(\x10|\x11|\x13)/) { 6411 my $tag = ord $1; 6412 $dumpType = 'JFXX'; 6413 my $tagTablePtr = GetTagTable('Image::ExifTool::JFIF::Extension'); 6414 my $tagInfo = $self->GetTagInfo($tagTablePtr, $tag); 6415 $self->FoundTag($tagInfo, substr($$segDataPt, 6)); 6416 } elsif ($$segDataPt =~ /^(II|MM).{4}HEAPJPGM/s) { 6417 next if $fast > 1; # skip processing for very fast 6418 $dumpType = 'CIFF'; 6419 my %dirInfo = ( RAF => new File::RandomAccess($segDataPt) ); 6420 $$self{SET_GROUP1} = 'CIFF'; 6421 push @{$$self{PATH}}, 'CIFF'; 6422 require Image::ExifTool::CanonRaw; 6423 Image::ExifTool::CanonRaw::ProcessCRW($self, \%dirInfo); 6424 pop @{$$self{PATH}}; 6425 delete $$self{SET_GROUP1}; 6426 } elsif ($$segDataPt =~ /^(AVI1|Ocad)/) { 6427 $dumpType = $1; 6428 SetByteOrder('MM'); 6429 my $tagTablePtr = GetTagTable("Image::ExifTool::JPEG::$dumpType"); 6430 DirStart(\%dirInfo, 4); 6431 $self->ProcessDirectory(\%dirInfo, $tagTablePtr); 6432 } 6433 } elsif ($marker == 0xe1) { # APP1 (EXIF, XMP, QVCI, PARROT) 6434 # (some Kodak cameras don't put a second "\0", and I have seen an 6435 # example where there was a second 4-byte APP1 segment header) 6436 if ($$segDataPt =~ /^(.{0,4})Exif\0/is) { 6437 undef $dumpType; # (will be dumped here) 6438 # this is EXIF data -- 6439 # get the data block (into a common variable) 6440 my $hdrLen = length($exifAPP1hdr); 6441 if (length $1) { 6442 $hdrLen += length $1; 6443 $self->Warn('Unknown garbage at start of EXIF segment',1); 6444 } elsif ($$segDataPt !~ /^Exif\0/) { 6445 $self->Warn('Incorrect EXIF segment identifier',1); 6446 } 6447 if ($htmlDump) { 6448 $self->HDump($segPos-4, 4, 'APP1 header', "Data size: $length bytes"); 6449 $self->HDump($segPos, $hdrLen, 'Exif header', 'APP1 data type: Exif'); 6450 $dumpEnd = $segPos + $length; 6451 } 6452 my $dataPt = $segDataPt; 6453 if (defined $combinedSegData) { 6454 push @skipData, [ $segPos-4, $segPos+$hdrLen ]; 6455 $combinedSegData .= substr($$segDataPt,$hdrLen); 6456 undef $$segDataPt; 6457 $dataPt = \$combinedSegData; 6458 $segPos = $firstSegPos; 6459 } 6460 # peek ahead to see if the next segment is extended EXIF 6461 if ($nextMarker == $marker and 6462 $$nextSegDataPt =~ /^$exifAPP1hdr(?!(MM\0\x2a|II\x2a\0))/) 6463 { 6464 # initialize combined data if necessary 6465 unless (defined $combinedSegData) { 6466 $combinedSegData = $$segDataPt; 6467 undef $$segDataPt; 6468 $firstSegPos = $segPos; 6469 $self->Warn('File contains multi-segment EXIF',1); 6470 $$self{ExtendedEXIF} = 1; 6471 } 6472 next; 6473 } 6474 $dirInfo{DataPt} = $dataPt; 6475 $dirInfo{DataPos} = $segPos; 6476 $dirInfo{DataLen} = $dirInfo{DirLen} = length $$dataPt; 6477 DirStart(\%dirInfo, $hdrLen, $hdrLen); 6478 $$self{SkipData} = \@skipData if @skipData; 6479 # extract the EXIF information (it is in standard TIFF format) 6480 $self->ProcessTIFF(\%dirInfo) or $self->Warn('Malformed APP1 EXIF segment'); 6481 # avoid looking for preview unless necessary because it really slows 6482 # us down -- only look for it if we found pointer, and preview is 6483 # outside EXIF, and PreviewImage is specifically requested 6484 my $start = $self->GetValue('PreviewImageStart', 'ValueConv'); 6485 my $plen = $self->GetValue('PreviewImageLength', 'ValueConv'); 6486 if (not $start or not $plen and $$self{PreviewError}) { 6487 $start = $$self{PreviewImageStart}; 6488 $plen = $$self{PreviewImageLength}; 6489 } 6490 if ($start and $plen and IsInt($start) and IsInt($plen) and 6491 $start + $plen > $$self{EXIF_POS} + length($$self{EXIF_DATA}) and 6492 ($$self{REQ_TAG_LOOKUP}{previewimage} or 6493 # (extracted normally, so check Binary option) 6494 ($$options{Binary} and not $$self{EXCL_TAG_LOOKUP}{previewimage}))) 6495 { 6496 $$self{PreviewImageStart} = $start; 6497 $$self{PreviewImageLength} = $plen; 6498 $wantTrailer = 1; 6499 } 6500 if (@skipData) { 6501 undef @skipData; 6502 delete $$self{SkipData}; 6503 } 6504 undef $$dataPt; 6505 next; 6506 } elsif ($$segDataPt =~ /^$xmpExtAPP1hdr/) { 6507 # off len -- extended XMP header (75 bytes total): 6508 # 0 35 bytes - signature 6509 # 35 32 bytes - GUID (MD5 hash of full extended XMP data in ASCII) 6510 # 67 4 bytes - total size of extended XMP data 6511 # 71 4 bytes - offset for this XMP data portion 6512 $dumpType = 'Extended XMP'; 6513 if ($length > 75) { 6514 my ($size, $off) = unpack('x67N2', $$segDataPt); 6515 my $guid = substr($$segDataPt, 35, 32); 6516 if ($guid =~ /[^A-Za-z0-9]/) { # (technically, should be uppercase) 6517 $self->WarnOnce($tip = 'Invalid extended XMP GUID'); 6518 } else { 6519 my $extXMP = $extendedXMP{$guid}; 6520 if (not $extXMP) { 6521 $extXMP = $extendedXMP{$guid} = { }; 6522 } elsif ($size != $$extXMP{Size}) { 6523 $self->WarnOnce('Inconsistent extended XMP size'); 6524 } 6525 $$extXMP{Size} = $size; 6526 $$extXMP{$off} = substr($$segDataPt, 75); 6527 $tip = "Full length: $size\nChunk offset: $off\nChunk length: " . 6528 ($length - 75) . "\nGUID: $guid"; 6529 # (delay processing extended XMP until after reading all segments) 6530 } 6531 } else { 6532 $self->WarnOnce($tip = 'Invalid extended XMP segment'); 6533 } 6534 } elsif ($$segDataPt =~ /^QVCI\0/) { 6535 $dumpType = 'QVCI'; 6536 my $tagTablePtr = GetTagTable('Image::ExifTool::Casio::QVCI'); 6537 $self->ProcessDirectory(\%dirInfo, $tagTablePtr); 6538 } elsif ($$segDataPt =~ /^FLIR\0/ and $length >= 8) { 6539 $dumpType = 'FLIR'; 6540 # must concatenate FLIR chunks (note: handle the case where 6541 # some software erroneously writes zeros for the chunk counts) 6542 my $chunkNum = Get8u($segDataPt, 6); 6543 my $chunksTot = Get8u($segDataPt, 7) + 1; # (note the "+ 1"!) 6544 $verbose and printf $out "$$self{INDENT}FLIR chunk %d of %d\n", 6545 $chunkNum + 1, $chunksTot; 6546 if (defined $flirTotal) { 6547 # abort parsing FLIR if the total chunk count is inconsistent 6548 undef $flirCount if $chunksTot != $flirTotal; 6549 } else { 6550 $flirCount = 0; 6551 $flirTotal = $chunksTot; 6552 } 6553 if (defined $flirCount) { 6554 if (defined $flirChunk[$chunkNum]) { 6555 $self->WarnOnce('Duplicate FLIR chunk number(s)'); 6556 $flirChunk[$chunkNum] .= substr($$segDataPt, 8); 6557 } else { 6558 $flirChunk[$chunkNum] = substr($$segDataPt, 8); 6559 } 6560 # process the FLIR information if we have all of the chunks 6561 if (++$flirCount >= $flirTotal) { 6562 my $flir = ''; 6563 defined $_ and $flir .= $_ foreach @flirChunk; 6564 undef @flirChunk; # free memory 6565 my $tagTablePtr = GetTagTable('Image::ExifTool::FLIR::FFF'); 6566 my %dirInfo = ( 6567 DataPt => \$flir, 6568 Parent => $markerName, 6569 DirName => 'FLIR', 6570 ); 6571 $self->ProcessDirectory(\%dirInfo, $tagTablePtr); 6572 undef $flirCount; # prevent reprocessing 6573 } 6574 } else { 6575 $self->WarnOnce('Invalid or extraneous FLIR chunk(s)'); 6576 } 6577 } elsif ($$segDataPt =~ /^PARROT\0(II\x2a\0|MM\0\x2a)/) { 6578 # (don't know if this could span multiple segments) 6579 my $tagTablePtr = GetTagTable('Image::ExifTool::JPEG::Main'); 6580 $self->HandleTag($tagTablePtr, 'APP1', $$segDataPt); 6581 $dumpType = 'Parrot'; 6582 } else { 6583 # Hmmm. Could be XMP, let's see 6584 my $processed; 6585 if ($$segDataPt =~ /^(http|XMP\0)/ or $$segDataPt =~ /<(exif:|\?xpacket)/) { 6586 $dumpType = 'XMP'; 6587 # also try to parse XMP with a non-standard header 6588 # (note: this non-standard XMP is ignored when writing) 6589 my $start = ($$segDataPt =~ /^$xmpAPP1hdr/) ? length($xmpAPP1hdr) : 0; 6590 my $tagTablePtr = GetTagTable('Image::ExifTool::XMP::Main'); 6591 DirStart(\%dirInfo, $start); 6592 $dirInfo{DirName} = $start ? 'XMP' : 'XML', 6593 $processed = $self->ProcessDirectory(\%dirInfo, $tagTablePtr); 6594 if ($processed and not $start) { 6595 $self->Warn('Non-standard header for APP1 XMP segment'); 6596 } 6597 } 6598 if ($verbose and not $processed) { 6599 $self->Warn("Ignored APP1 segment length $length (unknown header)"); 6600 } 6601 } 6602 } elsif ($marker == 0xe2) { # APP2 (ICC Profile, FPXR, MPF, PreviewImage) 6603 if ($$segDataPt =~ /^ICC_PROFILE\0/ and $length >= 14) { 6604 $dumpType = 'ICC_Profile'; 6605 # must concatenate profile chunks (note: handle the case where 6606 # some software erroneously writes zeros for the chunk counts) 6607 my $chunkNum = Get8u($segDataPt, 12); 6608 my $chunksTot = Get8u($segDataPt, 13); 6609 $verbose and print $out "$$self{INDENT}ICC_Profile chunk $chunkNum of $chunksTot\n"; 6610 if (defined $iccChunksTotal) { 6611 # abort parsing ICC_Profile if the total chunk count is inconsistent 6612 undef $iccChunkCount if $chunksTot != $iccChunksTotal; 6613 } else { 6614 $iccChunkCount = 0; 6615 $iccChunksTotal = $chunksTot; 6616 $self->Warn('ICC_Profile chunk count is zero') if !$chunksTot; 6617 } 6618 if (defined $iccChunkCount) { 6619 if (defined $iccChunk[$chunkNum]) { 6620 $self->WarnOnce('Duplicate ICC_Profile chunk number(s)'); 6621 $iccChunk[$chunkNum] .= substr($$segDataPt, 14); 6622 } else { 6623 $iccChunk[$chunkNum] = substr($$segDataPt, 14); 6624 } 6625 # process profile if we have all of the chunks 6626 if (++$iccChunkCount >= $iccChunksTotal) { 6627 my $icc_profile = ''; 6628 defined $_ and $icc_profile .= $_ foreach @iccChunk; 6629 undef @iccChunk; # free memory 6630 my $tagTablePtr = GetTagTable('Image::ExifTool::ICC_Profile::Main'); 6631 my %dirInfo = ( 6632 DataPt => \$icc_profile, 6633 DataPos => $segPos + 14, 6634 DataLen => length($icc_profile), 6635 DirStart => 0, 6636 DirLen => length($icc_profile), 6637 Parent => $markerName, 6638 ); 6639 $self->ProcessDirectory(\%dirInfo, $tagTablePtr); 6640 undef $iccChunkCount; # prevent reprocessing 6641 } 6642 } else { 6643 $self->WarnOnce('Invalid or extraneous ICC_Profile chunk(s)'); 6644 } 6645 } elsif ($$segDataPt =~ /^FPXR\0/) { 6646 next if $fast > 1; # skip processing for very fast 6647 $dumpType = 'FPXR'; 6648 my $tagTablePtr = GetTagTable('Image::ExifTool::FlashPix::Main'); 6649 # set flag if this is the last FPXR segment 6650 $dirInfo{LastFPXR} = not ($nextMarker==$marker and $$nextSegDataPt=~/^FPXR\0/), 6651 $self->ProcessDirectory(\%dirInfo, $tagTablePtr); 6652 } elsif ($$segDataPt =~ /^MPF\0/) { 6653 undef $dumpType; # (will be dumped here) 6654 DirStart(\%dirInfo, 4, 4); 6655 $dirInfo{Multi} = 1; # the MP Attribute IFD will be MPF1 6656 if ($htmlDump) { 6657 $self->HDump($segPos-4, 4, 'APP2 header', "Data size: $length bytes"); 6658 $self->HDump($segPos, 4, 'MPF header', 'APP2 data type: MPF'); 6659 $dumpEnd = $segPos + $length; 6660 } 6661 # extract the MPF information (it is in standard TIFF format) 6662 my $tagTablePtr = GetTagTable('Image::ExifTool::MPF::Main'); 6663 $self->ProcessTIFF(\%dirInfo, $tagTablePtr); 6664 } elsif ($$segDataPt =~ /^(|QVGA\0|BGTH)\xff\xd8\xff[\xdb\xe0\xe1]/) { 6665 # Samsung/GE/GoPro="", BenQ DC C1220/Pentacon/Polaroid="QVGA\0", 6666 # Digilife DDC-690/Rollei="BGTH" 6667 $dumpType = 'Preview Image'; 6668 $preview = substr($$segDataPt, length($1)); 6669 } elsif ($preview) { 6670 $dumpType = 'Preview Image'; 6671 $preview .= $$segDataPt; 6672 } 6673 if ($preview and $nextMarker ne $marker) { 6674 $self->FoundTag('PreviewImage', $preview); 6675 undef $preview; 6676 } 6677 } elsif ($marker == 0xe3) { # APP3 (Kodak "Meta", Stim) 6678 if ($$segDataPt =~ /^(Meta|META|Exif)\0\0/) { 6679 undef $dumpType; # (will be dumped here) 6680 DirStart(\%dirInfo, 6, 6); 6681 if ($htmlDump) { 6682 $self->HDump($segPos-4, 10, 'APP3 Meta header'); 6683 $dumpEnd = $segPos + $length; 6684 } 6685 my $tagTablePtr = GetTagTable('Image::ExifTool::Kodak::Meta'); 6686 $self->ProcessTIFF(\%dirInfo, $tagTablePtr); 6687 } elsif ($$segDataPt =~ /^Stim\0/) { 6688 undef $dumpType; # (will be dumped here) 6689 DirStart(\%dirInfo, 6, 6); 6690 if ($htmlDump) { 6691 $self->HDump($segPos-4, 4, 'APP3 header', "Data size: $length bytes"); 6692 $self->HDump($segPos, 5, 'Stim header', 'APP3 data type: Stim'); 6693 $dumpEnd = $segPos + $length; 6694 } 6695 # extract the Stim information (it is in standard TIFF format) 6696 my $tagTablePtr = GetTagTable('Image::ExifTool::Stim::Main'); 6697 $self->ProcessTIFF(\%dirInfo, $tagTablePtr); 6698 } elsif ($$segDataPt =~ /^\xff\xd8\xff\xdb/) { 6699 $dumpType = 'PreviewImage'; # (Samsung, HP, BenQ) 6700 $preview = $$segDataPt; 6701 } 6702 if ($preview and $nextMarker ne 0xe4) { # this preview continues in APP4 6703 $self->FoundTag('PreviewImage', $preview); 6704 undef $preview; 6705 } 6706 } elsif ($marker == 0xe4) { # APP4 ("SCALADO", FPXR, PreviewImage) 6707 if ($$segDataPt =~ /^SCALADO\0/ and $length >= 16) { 6708 $dumpType = 'SCALADO'; 6709 my ($num, $idx, $len) = unpack('x8n2N', $$segDataPt); 6710 # assume that the segments are in order and just concatinate them 6711 $scalado = '' unless defined $scalado; 6712 $scalado .= substr($$segDataPt, 16); 6713 if ($idx == $num - 1) { 6714 if ($len != length $scalado) { 6715 $self->Warn('Possibly corrupted APP4 SCALADO data', 1); 6716 } 6717 my %dirInfo = ( 6718 Parent => $markerName, 6719 DataPt => \$scalado, 6720 ); 6721 my $tagTablePtr = GetTagTable('Image::ExifTool::Scalado::Main'); 6722 $self->ProcessDirectory(\%dirInfo, $tagTablePtr); 6723 undef $scalado; 6724 } 6725 } elsif ($$segDataPt =~ /^FPXR\0/) { 6726 next if $fast > 1; # skip processing for very fast 6727 $dumpType = 'FPXR'; 6728 my $tagTablePtr = GetTagTable('Image::ExifTool::FlashPix::Main'); 6729 # set flag if this is the last FPXR segment 6730 $dirInfo{LastFPXR} = not ($nextMarker==$marker and $$nextSegDataPt=~/^FPXR\0/), 6731 $self->ProcessDirectory(\%dirInfo, $tagTablePtr); 6732 } elsif ($preview) { 6733 # continued Samsung S1060 preview from APP3 6734 $dumpType = 'PreviewImage'; 6735 $preview .= $$segDataPt; 6736 } 6737 # (also seen "QTI Debug Metadata\0" segment in some newer Samsung images) 6738 # BenQ DC E1050 continues preview in APP5 6739 if ($preview and $nextMarker ne 0xe5) { 6740 $self->FoundTag('PreviewImage', $preview); 6741 undef $preview; 6742 } 6743 } elsif ($marker == 0xe5) { # APP5 (Ricoh "RMETA") 6744 if ($$segDataPt =~ /^RMETA\0/) { 6745 # (NOTE: apparently these may span multiple segments, but I haven't seen 6746 # a sample like this, so multi-segment support hasn't yet been implemented) 6747 $dumpType = 'Ricoh RMETA'; 6748 DirStart(\%dirInfo, 6, 6); 6749 my $tagTablePtr = GetTagTable('Image::ExifTool::Ricoh::RMETA'); 6750 $self->ProcessDirectory(\%dirInfo, $tagTablePtr); 6751 } elsif ($$segDataPt =~ /^ssuniqueid\0/) { 6752 my $tagTablePtr = GetTagTable('Image::ExifTool::Samsung::APP5'); 6753 $self->HandleTag($tagTablePtr, 'ssuniqueid', substr($$segDataPt, 11)); 6754 } elsif ($preview) { 6755 $dumpType = 'PreviewImage'; 6756 $preview .= $$segDataPt; 6757 $self->FoundTag('PreviewImage', $preview); 6758 undef $preview; 6759 } 6760 } elsif ($marker == 0xe6) { # APP6 (Toshiba EPPIM, NITF, HP_TDHD) 6761 if ($$segDataPt =~ /^EPPIM\0/) { 6762 undef $dumpType; # (will be dumped here) 6763 DirStart(\%dirInfo, 6, 6); 6764 if ($htmlDump) { 6765 $self->HDump($segPos-4, 10, 'APP6 EPPIM header'); 6766 $dumpEnd = $segPos + $length; 6767 } 6768 my $tagTablePtr = GetTagTable('Image::ExifTool::JPEG::EPPIM'); 6769 $self->ProcessTIFF(\%dirInfo, $tagTablePtr); 6770 } elsif ($$segDataPt =~ /^NITF\0/) { 6771 $dumpType = 'NITF'; 6772 SetByteOrder('MM'); 6773 my $tagTablePtr = GetTagTable('Image::ExifTool::JPEG::NITF'); 6774 DirStart(\%dirInfo, 5); 6775 $self->ProcessDirectory(\%dirInfo, $tagTablePtr); 6776 } elsif ($$segDataPt =~ /^TDHD\x01\0\0\0/ and $length > 12) { 6777 # HP Photosmart R837 APP6 "TDHD" segment 6778 $dumpType = 'TDHD'; 6779 my $tagTablePtr = GetTagTable('Image::ExifTool::HP::TDHD'); 6780 # (ignore first TDHD element because size includes 12-byte tag header) 6781 DirStart(\%dirInfo, 12); 6782 $self->ProcessDirectory(\%dirInfo, $tagTablePtr); 6783 } elsif ($$segDataPt =~ /^GoPro\0/) { 6784 # GoPro segment 6785 $dumpType = 'GoPro'; 6786 my $tagTablePtr = GetTagTable('Image::ExifTool::GoPro::GPMF'); 6787 DirStart(\%dirInfo, 6); 6788 $self->ProcessDirectory(\%dirInfo, $tagTablePtr); 6789 } 6790 } elsif ($marker == 0xe7) { # APP7 (Pentax, Huawei, Qualcomm) 6791 if ($$segDataPt =~ /^PENTAX \0(II|MM)/) { 6792 # found in K-3 images (is this multi-segment??) 6793 SetByteOrder($1); 6794 undef $dumpType; # (dump this ourself) 6795 my $hdrLen = 10; 6796 my $tagTablePtr = GetTagTable('Image::ExifTool::Pentax::Main'); 6797 DirStart(\%dirInfo, $hdrLen, 0); 6798 $dirInfo{DirName} = 'Pentax APP7'; 6799 if ($htmlDump) { 6800 $self->HDump($segPos-4, 4, 'APP7 header', "Data size: $length bytes"); 6801 $self->HDump($segPos, $hdrLen, 'Pentax header', 'APP7 data type: Pentax'); 6802 $dumpEnd = $segPos + $length; 6803 } 6804 $self->ProcessDirectory(\%dirInfo, $tagTablePtr); 6805 } elsif ($$segDataPt =~ /^HUAWEI\0\0(II|MM)/) { 6806 SetByteOrder($1); 6807 undef $dumpType; # (dump this ourself) 6808 my $hdrLen = 16; 6809 my $tagTablePtr = GetTagTable('Image::ExifTool::Unknown::Main'); 6810 DirStart(\%dirInfo, $hdrLen, 8); 6811 $dirInfo{DirName} = 'Huawei APP7'; 6812 if ($htmlDump) { 6813 $self->HDump($segPos-4, 4, 'APP7 header', "Data size: $length bytes"); 6814 $self->HDump($segPos, $hdrLen, 'Huawei header', 'APP7 data type: Huawei'); 6815 $dumpEnd = $segPos + $length; 6816 } 6817 $$self{SET_GROUP0} = 'APP7'; 6818 $$self{SET_GROUP1} = 'Huawei'; 6819 $self->ProcessDirectory(\%dirInfo, $tagTablePtr); 6820 delete $$self{SET_GROUP0}; 6821 delete $$self{SET_GROUP1}; 6822 } elsif ($$segDataPt =~ /^\x1aQualcomm Camera Attributes/) { 6823 # found in HP iPAQ_VoiceMessenger 6824 $dumpType = 'Qualcomm'; 6825 my $tagTablePtr = GetTagTable('Image::ExifTool::Qualcomm::Main'); 6826 DirStart(\%dirInfo, 27); 6827 $dirInfo{DirName} = 'Qualcomm'; 6828 $self->ProcessDirectory(\%dirInfo, $tagTablePtr); 6829 } 6830 } elsif ($marker == 0xe8) { # APP8 (SPIFF) 6831 # my sample SPIFF has 32 bytes of data, but spec states 30 6832 if ($$segDataPt =~ /^SPIFF\0/ and $length == 32) { 6833 $dumpType = 'SPIFF'; 6834 DirStart(\%dirInfo, 6); 6835 my $tagTablePtr = GetTagTable('Image::ExifTool::JPEG::SPIFF'); 6836 $self->ProcessDirectory(\%dirInfo, $tagTablePtr); 6837 } 6838 } elsif ($marker == 0xe9) { # APP9 (Media Jukebox) 6839 if ($$segDataPt =~ /^Media Jukebox\0/ and $length > 22) { 6840 $dumpType = 'MediaJukebox'; 6841 # (start parsing after the "<MJMD>") 6842 DirStart(\%dirInfo, 22); 6843 $dirInfo{DirName} = 'MediaJukebox'; 6844 require Image::ExifTool::XMP; 6845 my $tagTablePtr = GetTagTable('Image::ExifTool::JPEG::MediaJukebox'); 6846 $self->ProcessDirectory(\%dirInfo, $tagTablePtr, \&Image::ExifTool::XMP::ProcessXMP); 6847 } 6848 } elsif ($marker == 0xea) { # APP10 (PhotoStudio Unicode comments) 6849 if ($$segDataPt =~ /^UNICODE\0/) { 6850 $dumpType = 'PhotoStudio'; 6851 my $comment = $self->Decode(substr($$segDataPt,8), 'UCS2', 'MM'); 6852 $self->FoundTag('Comment', $comment); 6853 } elsif ($$segDataPt =~ /^AROT\0/ and $length > 10) { 6854 # iPhone "AROT" segment containing integrated intensity per 16 scan lines 6855 # (with number of elements N = ImageHeight / 16 - 1, ref PH/NealKrawetz) 6856 $xtra = 'segment (N=' . unpack('x6N', $$segDataPt) . ')'; 6857 } 6858 } elsif ($marker == 0xeb) { # APP11 (JPEG-HDR) 6859 if ($$segDataPt =~ /^HDR_RI /) { 6860 $dumpType = 'JPEG-HDR'; 6861 my $dataPt = $segDataPt; 6862 if (defined $combinedSegData) { 6863 if ($$segDataPt =~ /~\0/g) { 6864 $combinedSegData .= substr($$segDataPt,pos($$segDataPt)); 6865 } else { 6866 $self->Warn('Invalid format for JPEG-HDR extended segment'); 6867 } 6868 $dataPt = \$combinedSegData; 6869 } 6870 if ($nextMarker == $marker and $$nextSegDataPt =~ /^HDR_RI /) { 6871 $combinedSegData = $$segDataPt unless defined $combinedSegData; 6872 } else { 6873 my $tagTablePtr = GetTagTable('Image::ExifTool::JPEG::HDR'); 6874 my %dirInfo = ( DataPt => $dataPt ); 6875 $self->ProcessDirectory(\%dirInfo, $tagTablePtr); 6876 undef $combinedSegData; 6877 } 6878 } 6879 } elsif ($marker == 0xec) { # APP12 (Ducky, Picture Info) 6880 if ($$segDataPt =~ /^Ducky/) { 6881 $dumpType = 'Ducky'; 6882 DirStart(\%dirInfo, 5); 6883 my $tagTablePtr = GetTagTable('Image::ExifTool::APP12::Ducky'); 6884 $self->ProcessDirectory(\%dirInfo, $tagTablePtr); 6885 } else { 6886 my $tagTablePtr = GetTagTable('Image::ExifTool::APP12::PictureInfo'); 6887 $self->ProcessDirectory(\%dirInfo, $tagTablePtr) and $dumpType = 'Picture Info'; 6888 } 6889 } elsif ($marker == 0xed) { # APP13 (Photoshop, Adobe_CM) 6890 my $isOld; 6891 if ($$segDataPt =~ /^$psAPP13hdr/ or ($$segDataPt =~ /^$psAPP13old/ and $isOld=1)) { 6892 $dumpType = 'Photoshop'; 6893 # add this data to the combined data if it exists 6894 my $dataPt = $segDataPt; 6895 if (defined $combinedSegData) { 6896 $combinedSegData .= substr($$segDataPt,length($psAPP13hdr)); 6897 $dataPt = \$combinedSegData; 6898 } 6899 # peek ahead to see if the next segment is photoshop data too 6900 if ($nextMarker == $marker and $$nextSegDataPt =~ /^$psAPP13hdr/) { 6901 # initialize combined data if necessary 6902 $combinedSegData = $$segDataPt unless defined $combinedSegData; 6903 # (will handle the Photoshop data the next time around) 6904 } else { 6905 my $hdrLen = $isOld ? 27 : 14; 6906 # process APP13 Photoshop record 6907 my $tagTablePtr = GetTagTable('Image::ExifTool::Photoshop::Main'); 6908 my %dirInfo = ( 6909 DataPt => $dataPt, 6910 DataPos => $segPos, 6911 DataLen => length $$dataPt, 6912 DirStart => $hdrLen, # directory starts after identifier 6913 DirLen => length($$dataPt) - $hdrLen, 6914 Parent => $markerName, 6915 ); 6916 $self->ProcessDirectory(\%dirInfo, $tagTablePtr); 6917 undef $combinedSegData; 6918 } 6919 } elsif ($$segDataPt =~ /^Adobe_CM/) { 6920 $dumpType = 'Adobe_CM'; 6921 SetByteOrder('MM'); 6922 my $tagTablePtr = GetTagTable('Image::ExifTool::JPEG::AdobeCM'); 6923 DirStart(\%dirInfo, 8); 6924 $self->ProcessDirectory(\%dirInfo, $tagTablePtr); 6925 } 6926 } elsif ($marker == 0xee) { # APP14 (Adobe) 6927 if ($$segDataPt =~ /^Adobe/) { 6928 # extract as a block if requested, or if copying tags from file 6929 if ($$self{REQ_TAG_LOOKUP}{adobe} or 6930 # (not extracted normally, so check TAGS_FROM_FILE) 6931 ($$self{TAGS_FROM_FILE} and not $$self{EXCL_TAG_LOOKUP}{adobe})) 6932 { 6933 $self->FoundTag('Adobe', $$segDataPt); 6934 } 6935 $dumpType = 'Adobe'; 6936 SetByteOrder('MM'); 6937 my $tagTablePtr = GetTagTable('Image::ExifTool::JPEG::Adobe'); 6938 DirStart(\%dirInfo, 5); 6939 $self->ProcessDirectory(\%dirInfo, $tagTablePtr); 6940 } 6941 } elsif ($marker == 0xef) { # APP15 (GraphicConverter) 6942 if ($$segDataPt =~ /^Q\s*(\d+)/ and $length == 4) { 6943 $dumpType = 'GraphicConverter'; 6944 my $tagTablePtr = GetTagTable('Image::ExifTool::JPEG::GraphConv'); 6945 $self->HandleTag($tagTablePtr, 'Q', $1); 6946 } 6947 } elsif ($marker == 0xfe) { # COM (JPEG comment) 6948 $dumpType = 'Comment'; 6949 $$segDataPt =~ s/\0+$//; # some dumb softwares add null terminators 6950 $self->FoundTag('Comment', $$segDataPt); 6951 } elsif ($marker == 0x64) { # CME (J2C comment and extension) 6952 $dumpType = 'Comment'; 6953 if ($length > 2) { 6954 my $reg = unpack('n', $$segDataPt); # get registration value 6955 my $val = substr($$segDataPt, 2); 6956 $val = $self->Decode($val, 'Latin') if $reg == 1; 6957 # (actually an extension for $reg==65535, but store as binary comment) 6958 $self->FoundTag('Comment', ($reg==0 or $reg==65535) ? \$val : $val); 6959 } 6960 } elsif ($marker == 0x51) { # SIZ (J2C) 6961 my ($w, $h) = unpack('x2N2', $$segDataPt); 6962 $self->FoundTag('ImageWidth', $w); 6963 $self->FoundTag('ImageHeight', $h); 6964 } elsif (($marker & 0xf0) != 0xe0) { 6965 $dumpType = "$markerName segment"; 6966 $desc = "[JPEG $markerName]"; # (other known JPEG segments) 6967 } 6968 if (defined $dumpType) { 6969 if (not $dumpType and ($$options{Unknown} or $$options{Validate})) { 6970 my $str = ($$segDataPt =~ /^([\x20-\x7e]{1,20})\0/) ? " '${1}'" : ''; 6971 $xtra = 'segment' unless $xtra; 6972 $self->Warn("Unknown $markerName$str $xtra", 1); 6973 } 6974 if ($htmlDump) { 6975 $desc or $desc = $markerName . ($dumpType ? " $dumpType" : '') . ' segment'; 6976 $self->HDump($segPos-4, $length+4, $desc, $tip, 0x08); 6977 $dumpEnd = $segPos + $length; 6978 } 6979 } 6980 undef $$segDataPt; 6981 } 6982 # process extended XMP now if it existed 6983 if (%extendedXMP) { 6984 my $guid; 6985 # GUID indicated by the last main XMP segment 6986 my $goodGuid = $$self{VALUE}{HasExtendedXMP} || ''; 6987 # GUID of the extended XMP that we will process ('2' for all) 6988 my $readGuid = $$options{ExtendedXMP} || 0; 6989 $readGuid = $goodGuid if $readGuid eq '1'; 6990 foreach $guid (sort keys %extendedXMP) { 6991 next unless length $guid == 32; # ignore other (internal) keys 6992 my $extXMP = $extendedXMP{$guid}; 6993 my ($off, @offsets, $warn); 6994 # make sure we have all chunks, and create a list of sorted offsets 6995 for ($off=0; $off<$$extXMP{Size}; ) { 6996 last unless defined $$extXMP{$off}; 6997 push @offsets, $off; 6998 $off += length $$extXMP{$off}; 6999 } 7000 unless ($off == $$extXMP{Size}) { 7001 $self->Warn("Incomplete extended XMP (GUID $guid)"); 7002 next; 7003 } 7004 if ($guid eq $readGuid or $readGuid eq '2') { 7005 $warn = 'Reading non-' if $guid ne $goodGuid; 7006 my $buff = ''; 7007 # assemble XMP all together 7008 $buff .= $$extXMP{$_} foreach @offsets; 7009 my $tagTablePtr = GetTagTable('Image::ExifTool::XMP::Main'); 7010 my %dirInfo = ( 7011 DataPt => \$buff, 7012 Parent => 'APP1', 7013 IsExtended => 1, 7014 ); 7015 $$path[$pn] = 'APP1'; 7016 $self->ProcessDirectory(\%dirInfo, $tagTablePtr); 7017 pop @$path; 7018 } else { 7019 $warn = 'Ignored '; 7020 $warn .= 'non-' if $guid ne $goodGuid; 7021 } 7022 $self->Warn("${warn}standard extended XMP (GUID $guid)") if $warn; 7023 delete $extendedXMP{$guid}; 7024 } 7025 } 7026 # calculate JPEGDigest if requested 7027 if (@dqt) { 7028 require Image::ExifTool::JPEGDigest; 7029 Image::ExifTool::JPEGDigest::Calculate($self, \@dqt, $subSampling); 7030 } 7031 # issue necessary warnings 7032 $self->Warn('Incomplete ICC_Profile record', 1) if defined $iccChunkCount; 7033 $self->Warn('Incomplete FLIR record', 1) if defined $flirCount; 7034 $self->Warn('Error reading PreviewImage', 1) if $$self{PreviewError}; 7035 $success or $self->Warn('JPEG format error'); 7036 pop @$path if @$path > $pn; 7037 return 1; 7038} 7039 7040#------------------------------------------------------------------------------ 7041# Extract metadata from an Exiv2 EXV file 7042# Inputs: 0) ExifTool object reference, 1) dirInfo ref with RAF set 7043# Returns: 1 on success, 0 if this wasn't a valid JPEG file 7044sub ProcessEXV($$) 7045{ 7046 my ($self, $dirInfo) = @_; 7047 return $self->ProcessJPEG($dirInfo); 7048} 7049 7050#------------------------------------------------------------------------------ 7051# Process EXIF file 7052# Inputs/Returns: same as ProcessTIFF 7053sub ProcessEXIF($$;$) 7054{ 7055 my ($self, $dirInfo, $tagTablePtr) = @_; 7056 return $self->ProcessTIFF($dirInfo, $tagTablePtr); 7057} 7058 7059#------------------------------------------------------------------------------ 7060# Process TIFF data (wrapper for DoProcessTIFF to allow re-entry) 7061# Inputs: 0) ExifTool object ref, 1) dirInfo ref, 2) optional tag table ref 7062# Returns: 1 if this looked like a valid EXIF block, 0 otherwise, or -1 on write error 7063sub ProcessTIFF($$;$) 7064{ 7065 my ($self, $dirInfo, $tagTablePtr) = @_; 7066 my $exifData = $$self{EXIF_DATA}; 7067 my $exifPos = $$self{EXIF_POS}; 7068 my $rtnVal = $self->DoProcessTIFF($dirInfo, $tagTablePtr); 7069 # restore original EXIF information (in case ProcessTIFF is nested) 7070 if (defined $exifData) { 7071 $$self{EXIF_DATA} = $exifData; 7072 $$self{EXIF_POS} = $exifPos; 7073 } 7074 return $rtnVal; 7075} 7076 7077#------------------------------------------------------------------------------ 7078# Process TIFF data 7079# Inputs: 0) ExifTool object ref, 1) dirInfo ref, 2) optional tag table ref 7080# Returns: 1 if this looked like a valid EXIF block, 0 otherwise, or -1 on write error 7081sub DoProcessTIFF($$;$) 7082{ 7083 my ($self, $dirInfo, $tagTablePtr) = @_; 7084 my $dataPt = $$dirInfo{DataPt}; 7085 my $fileType = $$dirInfo{Parent} || ''; 7086 my $raf = $$dirInfo{RAF}; 7087 my $base = $$dirInfo{Base} || 0; 7088 my $outfile = $$dirInfo{OutFile}; 7089 my ($err, $sig, $canonSig, $otherSig); 7090 7091 # attempt to read TIFF header 7092 $$self{EXIF_DATA} = ''; 7093 if ($raf) { 7094 if ($outfile) { 7095 $raf->Seek(0, 0) or return 0; 7096 if ($base) { 7097 $raf->Read($$dataPt, $base) == $base or return 0; 7098 Write($outfile, $$dataPt) or $err = 1; 7099 } 7100 } else { 7101 $raf->Seek($base, 0) or return 0; 7102 } 7103 # extract full EXIF block (for block copy) from EXIF file 7104 my $amount = $fileType eq 'EXIF' ? 65536 * 8 : 8; 7105 my $n = $raf->Read($$self{EXIF_DATA}, $amount); 7106 if ($n < 8) { 7107 return 0 if $n or not $outfile or $fileType ne 'EXIF'; 7108 # create EXIF file from scratch 7109 delete $$self{EXIF_DATA}; 7110 undef $raf; 7111 } 7112 if ($n > 8) { 7113 $raf->Seek(8, 0); 7114 if ($n == $amount) { 7115 $$self{EXIF_DATA} = substr($$self{EXIF_DATA}, 0, 8); 7116 $self->Warn('EXIF too large to extract as a block'); #(shouldn't happen) 7117 } 7118 } 7119 } elsif ($dataPt and length $$dataPt) { 7120 # save a copy of the EXIF data 7121 my $dirStart = $$dirInfo{DirStart} || 0; 7122 my $dirLen = $$dirInfo{DirLen} || (length($$dataPt) - $dirStart); 7123 $$self{EXIF_DATA} = substr($$dataPt, $dirStart, $dirLen); 7124 $self->VerboseDir('TIFF') if $$self{OPTIONS}{Verbose} and length($$self{INDENT}) > 2; 7125 } elsif ($outfile) { 7126 delete $$self{EXIF_DATA}; # create from scratch 7127 } else { 7128 $$self{EXIF_DATA} = ''; 7129 } 7130 unless (defined $$self{EXIF_DATA}) { 7131 # set default byte order for creating new GPS in CR3 images 7132 my $defaultByteOrder; 7133 if ($$dirInfo{DirName} and $$dirInfo{DirName} eq 'GPS') { 7134 $defaultByteOrder = $$self{SaveExifByteOrder}; 7135 } 7136 # create TIFF information from scratch 7137 if ($self->SetPreferredByteOrder($defaultByteOrder) eq 'MM') { 7138 $$self{EXIF_DATA} = "MM\0\x2a\0\0\0\x08"; 7139 } else { 7140 $$self{EXIF_DATA} = "II\x2a\0\x08\0\0\0"; 7141 } 7142 } 7143 $$self{EXIF_POS} = $base + $$self{BASE}; 7144 $$self{FIRST_EXIF_POS} = $$self{EXIF_POS} unless defined $$self{FIRST_EXIF_POS}; 7145 $dataPt = \$$self{EXIF_DATA}; 7146 7147 # set byte ordering 7148 my $byteOrder = substr($$dataPt,0,2); 7149 SetByteOrder($byteOrder) or return 0; 7150 7151 # verify the byte ordering 7152 my $identifier = Get16u($dataPt, 2); 7153 # identifier is 0x2a for TIFF (but 0x4f52, 0x5352 or ?? for ORF) 7154 # no longer do this because various files use different values 7155 # (TIFF=0x2a, RW2/RWL=0x55, HDP=0xbc, BTF=0x2b, ORF=0x4f52/0x5352/0x????) 7156 # return 0 unless $identifier == 0x2a; 7157 $self->Warn('Invalid magic number in EXIF TIFF header') if $fileType eq 'APP1' and $identifier != 0x2a; 7158 7159 # get offset to IFD0 7160 return 0 if length $$dataPt < 8; 7161 my $offset = Get32u($dataPt, 4); 7162 $offset >= 8 or return 0; 7163 7164 if ($raf) { 7165 # check for canon or EXIF signature 7166 # (Canon CR2 images should have an offset of 16, but it may be 7167 # greater if edited by PhotoMechanic) 7168 if ($identifier == 0x2a and $offset >= 16) { 7169 $raf->Read($sig, 8) == 8 or return 0; 7170 $$dataPt .= $sig; 7171 if ($sig =~ /^(CR\x02\0|\xba\xb0\xac\xbb|ExifMeta)/) { 7172 if ($sig eq 'ExifMeta') { 7173 $self->SetFileType($fileType = 'EXIF'); 7174 $otherSig = $sig; 7175 } else { 7176 $fileType = $sig =~ /^CR/ ? 'CR2' : 'Canon 1D RAW'; 7177 $canonSig = $sig; 7178 } 7179 $self->HDump($base+8, 8, "[$fileType header]") if $$self{HTML_DUMP}; 7180 } 7181 } elsif ($identifier == 0x55 and $fileType =~ /^(RAW|RW2|RWL|TIFF)$/) { 7182 # panasonic RAW, RW2 or RWL file 7183 my $magic; 7184 # test for RW2/RWL magic number 7185 if ($offset >= 0x18 and $raf->Read($magic, 16) and 7186 $magic eq "\x88\xe7\x74\xd8\xf8\x25\x1d\x4d\x94\x7a\x6e\x77\x82\x2b\x5d\x6a") 7187 { 7188 $fileType = 'RW2' unless $fileType eq 'RWL'; 7189 $self->HDump($base + 8, 16, '[RW2/RWL header]') if $$self{HTML_DUMP}; 7190 $otherSig = $magic; # save signature for writing 7191 } else { 7192 $fileType = 'RAW'; 7193 } 7194 $tagTablePtr = GetTagTable('Image::ExifTool::PanasonicRaw::Main'); 7195 } elsif ($fileType eq 'TIFF') { 7196 if ($identifier == 0x2b) { 7197 # this looks like a BigTIFF image 7198 $raf->Seek(0); 7199 require Image::ExifTool::BigTIFF; 7200 return 1 if Image::ExifTool::BigTIFF::ProcessBTF($self, $dirInfo); 7201 } elsif ($identifier == 0x4f52 or $identifier == 0x5352) { 7202 # Olympus ORF image (set FileType now because base type is 'ORF') 7203 $self->SetFileType($fileType = 'ORF'); 7204 } elsif ($identifier == 0x4352) { 7205 $fileType = 'DCP'; 7206 } elsif ($byteOrder eq 'II' and ($identifier & 0xff) == 0xbc) { 7207 $fileType = 'HDP'; # Windows HD Photo file 7208 # check version number 7209 my $ver = Get8u($dataPt, 3); 7210 if ($ver > 1) { 7211 $self->Error("Windows HD Photo version $ver files not yet supported"); 7212 return 1; 7213 } 7214 } 7215 } 7216 # we have a valid TIFF (or whatever) file 7217 if ($fileType and not $$self{VALUE}{FileType}) { 7218 my $lookup = $fileTypeLookup{$fileType}; 7219 $lookup = $fileTypeLookup{$lookup} unless ref $lookup or not $lookup; 7220 # use file extension to pre-determine type if extension is TIFF-based or type is RAW 7221 my $baseType = $lookup ? (ref $$lookup[0] ? $$lookup[0][0] : $$lookup[0]) : ''; 7222 my $t = ($baseType eq 'TIFF' or $fileType =~ /RAW/) ? $fileType : undef; 7223 $self->SetFileType($t); 7224 } 7225 # don't process file if FastScan == 3 7226 return 1 if not $outfile and $$self{OPTIONS}{FastScan} and $$self{OPTIONS}{FastScan} == 3; 7227 } 7228 # (accommodate CR3 images which have a TIFF directory with ExifIFD at the top level) 7229 my $ifdName = ($$dirInfo{DirName} and $$dirInfo{DirName} =~ /^(ExifIFD|GPS)$/) ? $1 : 'IFD0'; 7230 if (not $tagTablePtr or $$tagTablePtr{GROUPS}{0} eq 'EXIF') { 7231 $self->FoundTag('ExifByteOrder', $byteOrder) unless $outfile; 7232 } elsif ($$tagTablePtr{GROUPS}{0} eq 'MakerNotes') { # (for writing CR3 maker notes) 7233 $ifdName = $$tagTablePtr{GROUPS}{0}; 7234 } else { 7235 $ifdName = $$tagTablePtr{GROUPS}{1}; 7236 } 7237 if ($$self{HTML_DUMP}) { 7238 my $tip = sprintf("Byte order: %s endian\nIdentifier: 0x%.4x\n$ifdName offset: 0x%.4x", 7239 ($byteOrder eq 'II') ? 'Little' : 'Big', $identifier, $offset); 7240 $self->HDump($base, 8, 'TIFF header', $tip, 0); 7241 } 7242 # remember where we found the TIFF data (APP1, APP3, TIFF, NEF, etc...) 7243 $$self{TIFF_TYPE} = $fileType; 7244 7245 # get reference to the main EXIF table 7246 $tagTablePtr or $tagTablePtr = GetTagTable('Image::ExifTool::Exif::Main'); 7247 7248 # build directory information hash 7249 my %dirInfo = ( 7250 Base => $base, 7251 DataPt => $dataPt, 7252 DataLen => length $$dataPt, 7253 DataPos => 0, 7254 DirStart => $offset, 7255 DirLen => length($$dataPt) - $offset, 7256 RAF => $raf, 7257 DirName => $ifdName, 7258 Parent => $fileType, 7259 ImageData=> 'Main', # set flag to get information to copy main image data later 7260 Multi => $$dirInfo{Multi}, 7261 ); 7262 7263 # extract information from the image 7264 unless ($outfile) { 7265 # process the directory 7266 $self->ProcessDirectory(\%dirInfo, $tagTablePtr); 7267 # process GeoTiff information if available 7268 if ($$self{VALUE}{GeoTiffDirectory}) { 7269 require Image::ExifTool::GeoTiff; 7270 Image::ExifTool::GeoTiff::ProcessGeoTiff($self); 7271 } 7272 # process information in recognized trailers 7273 if ($raf) { 7274 my $trailInfo = IdentifyTrailer($raf); 7275 if ($trailInfo) { 7276 $$trailInfo{ScanForAFCP} = 1; # scan to find AFCP if necessary 7277 $self->ProcessTrailers($trailInfo); 7278 } 7279 # dump any other known trailer (eg. A100 RAW Data) 7280 if ($$self{HTML_DUMP} and $$self{KnownTrailer}) { 7281 my $known = $$self{KnownTrailer}; 7282 $raf->Seek(0, 2); 7283 my $len = $raf->Tell() - $$known{Start}; 7284 $len -= $$trailInfo{Offset} if $trailInfo; # account for other trailers 7285 $self->HDump($$known{Start}, $len, "[$$known{Name}]") if $len > 0; 7286 } 7287 } 7288 # update FileType if necessary now that we know more about the file 7289 if ($$self{DNGVersion} and $$self{VALUE}{FileType} !~ /^(DNG|GPR)$/) { 7290 # override whatever FileType we set since we now know it is DNG 7291 $self->OverrideFileType($$self{TIFF_TYPE} = 'DNG'); 7292 } 7293 return 1; 7294 } 7295# 7296# rewrite the image 7297# 7298 if ($$dirInfo{NoTiffEnd}) { 7299 delete $$self{TIFF_END}; 7300 } else { 7301 # initialize TIFF_END so it will be updated by WriteExif() 7302 $$self{TIFF_END} = 0; 7303 } 7304 if ($canonSig) { 7305 # write Canon CR2 specially because it has a header we want to preserve, 7306 # and possibly trailers added by the Canon utilities and/or PhotoMechanic 7307 $dirInfo{OutFile} = $outfile; 7308 require Image::ExifTool::CanonRaw; 7309 Image::ExifTool::CanonRaw::WriteCR2($self, \%dirInfo, $tagTablePtr) or $err = 1; 7310 } else { 7311 # write TIFF header (8 bytes [plus optional signature] followed by IFD) 7312 if ($fileType eq 'EXIF') { 7313 $otherSig = 'ExifMeta'; # force this signature for all EXIF files 7314 } elsif (not defined $otherSig) { 7315 $otherSig = ''; 7316 } 7317 my $offset = 8 + length($otherSig); 7318 # construct tiff header 7319 my $header = substr($$dataPt, 0, 4) . Set32u($offset) . $otherSig; 7320 $dirInfo{NewDataPos} = $offset; 7321 $dirInfo{HeaderPtr} = \$header; 7322 # preserve padding between image data blocks in ORF images 7323 # (otherwise dcraw has problems because it assumes fixed block spacing) 7324 $dirInfo{PreserveImagePadding} = 1 if $fileType eq 'ORF' or $identifier != 0x2a; 7325 my $newData = $self->WriteDirectory(\%dirInfo, $tagTablePtr); 7326 if (not defined $newData) { 7327 $err = 1; 7328 } elsif (length($newData)) { 7329 # update header length in case more was added 7330 my $hdrLen = length $header; 7331 if ($hdrLen != 8) { 7332 Set32u($hdrLen, \$header, 4); 7333 # also update preview fixup if necessary 7334 my $pi = $$self{PREVIEW_INFO}; 7335 $$pi{Fixup}{Start} += $hdrLen - 8 if $pi and $$pi{Fixup}; 7336 } 7337 if ($$self{TIFF_TYPE} eq 'ARW' and not $err) { 7338 # write any required ARW trailer and patch other ARW quirks 7339 require Image::ExifTool::Sony; 7340 my $errStr = Image::ExifTool::Sony::FinishARW($self, $dirInfo, \$newData, 7341 $dirInfo{ImageData}); 7342 $errStr and $self->Error($errStr); 7343 delete $dirInfo{ImageData}; # (was copied by FinishARW) 7344 } else { 7345 Write($outfile, $header, $newData) or $err = 1; 7346 } 7347 undef $newData; # free memory 7348 } 7349 # copy over image data now if necessary 7350 if (ref $dirInfo{ImageData} and not $err) { 7351 $self->CopyImageData($dirInfo{ImageData}, $outfile) or $err = 1; 7352 delete $dirInfo{ImageData}; 7353 } 7354 } 7355 # make local copy of TIFF_END now (it may be reset when processing trailers) 7356 my $tiffEnd = $$self{TIFF_END}; 7357 delete $$self{TIFF_END}; 7358 7359 # rewrite trailers if they exist 7360 if ($raf and $tiffEnd and not $err) { 7361 my ($buf, $trailInfo); 7362 $raf->Seek(0, 2) or $err = 1; 7363 my $extra = $raf->Tell() - $tiffEnd; 7364 # check for trailer and process if possible 7365 for (;;) { 7366 last unless $extra > 12; 7367 $raf->Seek($tiffEnd); # seek back to end of image 7368 $trailInfo = IdentifyTrailer($raf); 7369 last unless $trailInfo; 7370 my $tbuf = ''; 7371 $$trailInfo{OutFile} = \$tbuf; # rewrite trailer(s) 7372 $$trailInfo{ScanForAFCP} = 1; # scan for AFCP if necessary 7373 # rewrite all trailers to buffer 7374 unless ($self->ProcessTrailers($trailInfo)) { 7375 undef $trailInfo; 7376 $err = 1; 7377 last; 7378 } 7379 # calculate unused bytes before trailer 7380 $extra = $$trailInfo{DataPos} - $tiffEnd; 7381 last; # yes, the 'for' loop was just a cheap 'goto' 7382 } 7383 # ignore a single zero byte if used for padding 7384 if ($extra > 0 and $tiffEnd & 0x01) { 7385 $raf->Seek($tiffEnd, 0) or $err = 1; 7386 $raf->Read($buf, 1) or $err = 1; 7387 defined $buf and $buf eq "\0" and --$extra, ++$tiffEnd; 7388 } 7389 if ($extra > 0) { 7390 my $known = $$self{KnownTrailer}; 7391 if ($$self{DEL_GROUP}{Trailer} and not $known) { 7392 $self->VPrint(0, " Deleting unknown trailer ($extra bytes)\n"); 7393 ++$$self{CHANGED}; 7394 } elsif ($known) { 7395 $self->VPrint(0, " Copying $$known{Name} ($extra bytes)\n"); 7396 $raf->Seek($tiffEnd, 0) or $err = 1; 7397 CopyBlock($raf, $outfile, $extra) or $err = 1; 7398 } else { 7399 $raf->Seek($tiffEnd, 0) or $err = 1; 7400 # preserve unknown trailer only if it contains non-null data 7401 # (Photoshop CS adds a trailer with 2 null bytes) 7402 my $size = $extra; 7403 for (;;) { 7404 my $n = $size > 65536 ? 65536 : $size; 7405 $raf->Read($buf, $n) == $n or $err = 1, last; 7406 if ($buf =~ /[^\0]/) { 7407 $self->VPrint(0, " Preserving unknown trailer ($extra bytes)\n"); 7408 # copy the trailer since it contains non-null data 7409 Write($outfile, "\0"x($extra-$size)) or $err = 1, last if $size != $extra; 7410 Write($outfile, $buf) or $err = 1, last; 7411 CopyBlock($raf, $outfile, $size-$n) or $err = 1 if $size > $n; 7412 last; 7413 } 7414 $size -= $n; 7415 next if $size > 0; 7416 $self->VPrint(0, " Deleting blank trailer ($extra bytes)\n"); 7417 last; 7418 } 7419 } 7420 } 7421 # write trailer buffer if necessary 7422 $self->WriteTrailerBuffer($trailInfo, $outfile) or $err = 1 if $trailInfo; 7423 # add any new trailers we are creating 7424 my $trailPt = $self->AddNewTrailers(); 7425 Write($outfile, $$trailPt) or $err = 1 if $trailPt; 7426 } 7427 # check DNG version 7428 if ($$self{DNGVersion}) { 7429 my $ver = $$self{DNGVersion}; 7430 # currently support up to DNG version 1.5 7431 unless ($ver =~ /^(\d+) (\d+)/ and "$1.$2" <= 1.5) { 7432 $ver =~ tr/ /./; 7433 $self->Error("DNG Version $ver not yet tested", 1); 7434 } 7435 } 7436 return $err ? -1 : 1; 7437} 7438 7439#------------------------------------------------------------------------------ 7440# Return list of tag table keys (ignoring special keys) 7441# Inputs: 0) reference to tag table 7442# Returns: List of table keys (unsorted) 7443sub TagTableKeys($) 7444{ 7445 local $_; 7446 my $tagTablePtr = shift; 7447 my @keyList; 7448 foreach (keys %$tagTablePtr) { 7449 push(@keyList, $_) unless $specialTags{$_}; 7450 } 7451 return @keyList; 7452} 7453 7454#------------------------------------------------------------------------------ 7455# GetTagTable 7456# Inputs: 0) table name 7457# Returns: tag table reference, or undefined if not found 7458# Notes: Always use this function instead of requiring module and using table 7459# directly since this function also does the following the first time the table 7460# is loaded: 7461# - requires new module if necessary 7462# - generates default GROUPS hash and Group 0 name from module name 7463# - registers Composite tags if Composite table found 7464# - saves descriptions for tags in specified table 7465# - generates default TAG_PREFIX to be used for unknown tags 7466sub GetTagTable($) 7467{ 7468 my $tableName = shift or return undef; 7469 my $table = $allTables{$tableName}; 7470 7471 unless ($table) { 7472 no strict 'refs'; 7473 unless (%$tableName) { 7474 # try to load module for this table 7475 if ($tableName =~ /(.*)::/) { 7476 my $module = $1; 7477 if (eval "require $module") { 7478 # load additional modules if required 7479 if (not %$tableName) { 7480 if ($module eq 'Image::ExifTool::XMP') { 7481 require 'Image/ExifTool/XMP2.pl'; 7482 } elsif ($tableName eq 'Image::ExifTool::QuickTime::Stream') { 7483 require 'Image/ExifTool/QuickTimeStream.pl'; 7484 } 7485 } 7486 } else { 7487 $@ and warn $@; 7488 } 7489 } 7490 unless (%$tableName) { 7491 warn "Can't find table $tableName\n"; 7492 return undef; 7493 } 7494 } 7495 no strict 'refs'; 7496 $table = \%$tableName; 7497 use strict 'refs'; 7498 &{$$table{INIT_TABLE}}($table) if $$table{INIT_TABLE}; 7499 $$table{TABLE_NAME} = $tableName; # set table name 7500 ($$table{SHORT_NAME} = $tableName) =~ s/^Image::ExifTool:://; 7501 # set default group 0 and 1 from module name unless already specified 7502 my $defaultGroups = $$table{GROUPS}; 7503 $defaultGroups or $defaultGroups = $$table{GROUPS} = { }; 7504 unless ($$defaultGroups{0} and $$defaultGroups{1}) { 7505 if ($tableName =~ /Image::.*?::([^:]*)/) { 7506 $$defaultGroups{0} = $1 unless $$defaultGroups{0}; 7507 $$defaultGroups{1} = $1 unless $$defaultGroups{1}; 7508 } else { 7509 $$defaultGroups{0} = $tableName unless $$defaultGroups{0}; 7510 $$defaultGroups{1} = $tableName unless $$defaultGroups{1}; 7511 } 7512 } 7513 $$defaultGroups{2} = 'Other' unless $$defaultGroups{2}; 7514 if ($$defaultGroups{0} eq 'XMP' or $$table{NAMESPACE}) { 7515 # initialize some XMP table defaults 7516 require Image::ExifTool::XMP; 7517 Image::ExifTool::XMP::RegisterNamespace($table); # register all table namespaces 7518 # set default write/check procs 7519 $$table{WRITE_PROC} = \&Image::ExifTool::XMP::WriteXMP unless $$table{WRITE_PROC}; 7520 $$table{CHECK_PROC} = \&Image::ExifTool::XMP::CheckXMP unless $$table{CHECK_PROC}; 7521 $$table{LANG_INFO} = \&Image::ExifTool::XMP::GetLangInfo unless $$table{LANG_INFO}; 7522 } 7523 # generate a tag prefix for unknown tags if necessary 7524 unless (defined $$table{TAG_PREFIX}) { 7525 my $tagPrefix; 7526 if ($tableName =~ /Image::.*?::(.*)::Main/ || $tableName =~ /Image::.*?::(.*)/) { 7527 ($tagPrefix = $1) =~ s/::/_/g; 7528 } else { 7529 $tagPrefix = $tableName; 7530 } 7531 $$table{TAG_PREFIX} = $tagPrefix; 7532 } 7533 # set up the new table 7534 SetupTagTable($table); 7535 # add any user-defined tags (except Composite tags, which are handled specially) 7536 if (%UserDefined and $UserDefined{$tableName} and $table ne \%Image::ExifTool::Composite) { 7537 my $tagID; 7538 foreach $tagID (TagTableKeys($UserDefined{$tableName})) { 7539 next if $specialTags{$tagID}; 7540 delete $$table{$tagID}; # replace any existing entry 7541 AddTagToTable($table, $tagID, $UserDefined{$tableName}{$tagID}, 1); 7542 } 7543 } 7544 # remember order we loaded the tables in 7545 push @tableOrder, $tableName; 7546 # insert newly loaded table into list 7547 $allTables{$tableName} = $table; 7548 } 7549 # must check each time to add UserDefined Composite tags because the Composite table 7550 # may be loaded before the UserDefined tags are available 7551 if ($table eq \%Image::ExifTool::Composite and not $$table{VARS}{LOADED_USERDEFINED} and 7552 %UserDefined and $UserDefined{$tableName}) 7553 { 7554 my $userComp = $UserDefined{$tableName}; 7555 delete $UserDefined{$tableName}; # (must delete first to avoid infinite recursion) 7556 AddCompositeTags($userComp, 1); 7557 $UserDefined{$tableName} = $userComp; # (add back again for adding writable tags later) 7558 $$table{VARS}{LOADED_USERDEFINED} = 1; # set flag to avoid doing this again 7559 } 7560 return $table; 7561} 7562 7563#------------------------------------------------------------------------------ 7564# Process an image directory 7565# Inputs: 0) ExifTool object reference, 1) directory information reference 7566# 2) tag table reference, 3) optional reference to processing procedure 7567# Returns: Result from processing (1=success) 7568sub ProcessDirectory($$$;$) 7569{ 7570 my ($self, $dirInfo, $tagTablePtr, $proc) = @_; 7571 7572 return 0 unless $tagTablePtr and $dirInfo; 7573 # use default proc from tag table or EXIF proc as fallback if no proc specified 7574 $proc or $proc = $$tagTablePtr{PROCESS_PROC} || \&Image::ExifTool::Exif::ProcessExif; 7575 # set directory name from default group0 name if not done already 7576 my $dirName = $$dirInfo{DirName}; 7577 unless ($dirName) { 7578 $dirName = $$tagTablePtr{GROUPS}{0}; 7579 $dirName = $$tagTablePtr{GROUPS}{1} if $dirName =~ /^APP\d+$/; # (use specific APP name) 7580 $$dirInfo{DirName} = $dirName; 7581 } 7582 7583 # guard against cyclical recursion into the same directory 7584 if (defined $$dirInfo{DirStart} and defined $$dirInfo{DataPos} and 7585 # directories don't overlap if the length is zero 7586 ($$dirInfo{DirLen} or not defined $$dirInfo{DirLen})) 7587 { 7588 my $addr = $$dirInfo{DirStart} + $$dirInfo{DataPos} + ($$dirInfo{Base}||0) + $$self{BASE}; 7589 if ($$self{PROCESSED}{$addr}) { 7590 $self->Warn("$dirName pointer references previous $$self{PROCESSED}{$addr} directory"); 7591 # patch for bug in Windows phone 7.5 O/S that writes incorrect InteropIFD pointer 7592 return 0 unless $dirName eq 'GPS' and $$self{PROCESSED}{$addr} eq 'InteropIFD'; 7593 } 7594 $$self{PROCESSED}{$addr} = $dirName; 7595 } 7596 my $oldOrder = GetByteOrder(); 7597 my @save = @$self{'INDENT','DIR_NAME','Compression','SubfileType'}; 7598 $$self{LIST_TAGS} = { }; # don't build lists across different directories 7599 $$self{INDENT} .= '| '; 7600 $$self{DIR_NAME} = $dirName; 7601 push @{$$self{PATH}}, $dirName; 7602 $$self{FOUND_DIR}{$dirName} = 1; 7603 7604 # process the directory 7605 no strict 'refs'; 7606 my $rtnVal = &$proc($self, $dirInfo, $tagTablePtr); 7607 use strict 'refs'; 7608 7609 pop @{$$self{PATH}}; 7610 @$self{'INDENT','DIR_NAME','Compression','SubfileType'} = @save; 7611 SetByteOrder($oldOrder); 7612 return $rtnVal; 7613} 7614 7615#------------------------------------------------------------------------------ 7616# Get Metadata path 7617# Inputs: 0) ExifTool object ref 7618# Return: Metadata path string 7619sub MetadataPath($) 7620{ 7621 my $self = shift; 7622 return join '-', @{$$self{PATH}} 7623} 7624 7625#------------------------------------------------------------------------------ 7626# Get standardized file extension 7627# Inputs: 0) file name 7628# Returns: standardized extension (all uppercase), or undefined if no extension 7629sub GetFileExtension($) 7630{ 7631 my $filename = shift; 7632 my $fileExt; 7633 if ($filename and $filename =~ /^.*\.([^.]+)$/s) { 7634 $fileExt = uc($1); # change extension to upper case 7635 # convert TIF extension to TIFF because we use the 7636 # extension for the file type tag of TIFF images 7637 $fileExt eq 'TIF' and $fileExt = 'TIFF'; 7638 } 7639 return $fileExt; 7640} 7641 7642#------------------------------------------------------------------------------ 7643# Get list of tag information hashes for given tag ID 7644# Inputs: 0) Tag table reference, 1) tag ID 7645# Returns: Array of tag information references 7646# Notes: Generates tagInfo hash if necessary 7647sub GetTagInfoList($$) 7648{ 7649 my ($tagTablePtr, $tagID) = @_; 7650 my $tagInfo = $$tagTablePtr{$tagID}; 7651 7652 if ($specialTags{$tagID}) { 7653 # (hopefully this won't happen) 7654 warn "Tag $tagID conflicts with internal ExifTool variable in $$tagTablePtr{TABLE_NAME}\n"; 7655 } elsif (ref $tagInfo eq 'HASH') { 7656 return ($tagInfo); 7657 } elsif (ref $tagInfo eq 'ARRAY') { 7658 return @$tagInfo; 7659 } elsif ($tagInfo) { 7660 # create hash with name 7661 $tagInfo = $$tagTablePtr{$tagID} = { Name => $tagInfo }; 7662 return ($tagInfo); 7663 } 7664 return (); 7665} 7666 7667#------------------------------------------------------------------------------ 7668# Find tag information, processing conditional tags 7669# Inputs: 0) ExifTool object reference, 1) tagTable pointer, 2) tag ID 7670# 3) optional value reference, 4) optional format type, 5) optional value count 7671# Returns: pointer to tagInfo hash, undefined if none found, or '' if $valPt needed 7672# Notes: You should always call this routine to find a tag in a table because 7673# this routine will evaluate conditional tags. 7674# Arguments 3-5 are only required if the information type allows $valPt, $format and/or 7675# $count in a Condition, and if not given when needed this routine returns ''. 7676sub GetTagInfo($$$;$$$) 7677{ 7678 my ($self, $tagTablePtr, $tagID) = @_; 7679 my ($valPt, $format, $count); 7680 7681 my @infoArray = GetTagInfoList($tagTablePtr, $tagID); 7682 # evaluate condition 7683 my $tagInfo; 7684 foreach $tagInfo (@infoArray) { 7685 my $condition = $$tagInfo{Condition}; 7686 if ($condition) { 7687 ($valPt, $format, $count) = splice(@_, 3) if @_ > 3; 7688 return '' if $condition =~ /\$(valPt|format|count)\b/ and not defined $valPt; 7689 # set old value for use in condition if needed 7690 local $SIG{'__WARN__'} = \&SetWarning; 7691 undef $evalWarning; 7692 #### eval Condition ($self, [$valPt, $format, $count]) 7693 unless (eval $condition) { 7694 $@ and $evalWarning = $@; 7695 $self->Warn("Condition $$tagInfo{Name}: " . CleanWarning()) if $evalWarning; 7696 next; 7697 } 7698 } 7699 if ($$tagInfo{Unknown} and not $$self{OPTIONS}{Unknown} and 7700 not $$self{OPTIONS}{Verbose} and not $$self{HTML_DUMP}) 7701 { 7702 # don't return Unknown tags unless that option is set 7703 return undef; 7704 } 7705 # return the tag information we found 7706 return $tagInfo; 7707 } 7708 # generate information for unknown tags (numerical only) if required 7709 if (not $tagInfo and ($$self{OPTIONS}{Unknown} or $$self{OPTIONS}{Verbose}) and 7710 $tagID =~ /^\d+$/ and not $$self{NO_UNKNOWN}) 7711 { 7712 my $printConv; 7713 if (defined $$tagTablePtr{PRINT_CONV}) { 7714 $printConv = $$tagTablePtr{PRINT_CONV}; 7715 } else { 7716 # limit length of printout (can be very long) 7717 $printConv = 'length($val) > 60 ? substr($val,0,55) . "[...]" : $val'; 7718 } 7719 my $hex = sprintf("0x%.4x", $tagID); 7720 my $prefix = $$tagTablePtr{TAG_PREFIX}; 7721 $tagInfo = { 7722 Name => "${prefix}_$hex", 7723 Description => MakeDescription($prefix, $hex), 7724 Unknown => 1, 7725 Writable => 0, # can't write unknown tags 7726 PrintConv => $printConv, 7727 }; 7728 # add tag information to table 7729 AddTagToTable($tagTablePtr, $tagID, $tagInfo); 7730 } else { 7731 undef $tagInfo; 7732 } 7733 return $tagInfo; 7734} 7735 7736#------------------------------------------------------------------------------ 7737# Add new tag to table (must use this routine to add new tags to a table) 7738# Inputs: 0) reference to tag table, 1) tag ID 7739# 2) [optional] tag name or reference to tag information hash 7740# 3) [optional] flag to avoid adding prefix when generating tag name 7741# Returns: tagInfo ref 7742# Notes: - will not override existing entry in table 7743# - info need contain no entries when this routine is called 7744# - tag name is cleaned if necessary 7745sub AddTagToTable($$;$$) 7746{ 7747 my ($tagTablePtr, $tagID, $tagInfo, $noPrefix) = @_; 7748 7749 # generate tag info hash if necessary 7750 $tagInfo = $tagInfo ? { Name => $tagInfo } : { } unless ref $tagInfo eq 'HASH'; 7751 7752 # define necessary entries in information hash 7753 if ($$tagInfo{Groups}) { 7754 # fill in default groups from table GROUPS 7755 foreach (keys %{$$tagTablePtr{GROUPS}}) { 7756 next if $$tagInfo{Groups}{$_}; 7757 $$tagInfo{Groups}{$_} = $$tagTablePtr{GROUPS}{$_}; 7758 } 7759 } else { 7760 $$tagInfo{Groups} = { %{$$tagTablePtr{GROUPS}} }; 7761 } 7762 $$tagInfo{Flags} and ExpandFlags($tagInfo); 7763 $$tagInfo{GotGroups} = 1, 7764 $$tagInfo{Table} = $tagTablePtr; 7765 $$tagInfo{TagID} = $tagID; 7766 if (defined $$tagTablePtr{AVOID} and not defined $$tagInfo{Avoid}) { 7767 $$tagInfo{Avoid} = $$tagTablePtr{AVOID}; 7768 } 7769 7770 my $name = $$tagInfo{Name}; 7771 $name = $tagID unless defined $name; 7772 $name =~ tr/-_a-zA-Z0-9//dc; # remove illegal characters 7773 $name = ucfirst $name; # capitalize first letter 7774 # add tag-name prefix if specified and tag name not provided 7775 unless (defined $$tagInfo{Name} or $noPrefix or not $$tagTablePtr{TAG_PREFIX}) { 7776 # make description to prevent tagID from getting mangled by MakeDescription() 7777 $$tagInfo{Description} = MakeDescription($$tagTablePtr{TAG_PREFIX}, $name); 7778 $name = "$$tagTablePtr{TAG_PREFIX}_$name"; 7779 } 7780 # tag names must be at least 2 characters long and prefer them to start with a letter 7781 $name = "Tag$name" if length($name) < 2 or $name !~ /^[A-Z]/i; 7782 $$tagInfo{Name} = $name; 7783 # add tag to table, but never override existing entries (could potentially happen 7784 # if someone thinks there isn't any tagInfo because a condition wasn't satisfied) 7785 unless (defined $$tagTablePtr{$tagID} or $specialTags{$tagID}) { 7786 $$tagTablePtr{$tagID} = $tagInfo; 7787 } 7788 return $tagInfo; 7789} 7790 7791#------------------------------------------------------------------------------ 7792# Handle simple extraction of new tag information 7793# Inputs: 0) ExifTool object ref, 1) tag table reference, 2) tagID, 3) value, 7794# 4-N) parameters hash: Index, DataPt, DataPos, Base, Start, Size, Parent, 7795# TagInfo, ProcessProc, RAF, Format, Count 7796# Returns: tag key or undef if tag not found 7797# Notes: if value is not defined, it is extracted from DataPt using TagInfo 7798# Format and Count if provided 7799sub HandleTag($$$$;%) 7800{ 7801 my ($self, $tagTablePtr, $tag, $val, %parms) = @_; 7802 my $verbose = $$self{OPTIONS}{Verbose}; 7803 my $pfmt = $parms{Format}; 7804 my $tagInfo = $parms{TagInfo} || $self->GetTagInfo($tagTablePtr, $tag, \$val, $pfmt, $parms{Count}); 7805 my $dataPt = $parms{DataPt}; 7806 my ($subdir, $format, $noTagInfo, $rational); 7807 7808 if ($tagInfo) { 7809 $subdir = $$tagInfo{SubDirectory}; 7810 } else { 7811 return undef unless $verbose; 7812 $tagInfo = { Name => "tag $tag" }; # create temporary tagInfo hash 7813 $noTagInfo = 1; 7814 } 7815 # read value if not done already (not necessary for subdir) 7816 unless (defined $val or ($subdir and not $$tagInfo{Writable} and not $$tagInfo{RawConv})) { 7817 my $start = $parms{Start} || 0; 7818 my $dLen = $dataPt ? length($$dataPt) : -1; 7819 my $size = $parms{Size}; 7820 $size = $dLen unless defined $size; 7821 # read from data in memory if possible 7822 if ($start >= 0 and $start + $size <= $dLen) { 7823 $format = $$tagInfo{Format} || $$tagTablePtr{FORMAT}; 7824 $format = $pfmt if not $format and $pfmt and $formatSize{$pfmt}; 7825 if ($format) { 7826 $val = ReadValue($dataPt, $start, $format, $$tagInfo{Count}, $size, \$rational); 7827 } else { 7828 $val = substr($$dataPt, $start, $size); 7829 } 7830 } else { 7831 $self->Warn("Error extracting value for $$tagInfo{Name}"); 7832 return undef; 7833 } 7834 } 7835 # do verbose print if necessary 7836 if ($verbose) { 7837 undef $tagInfo if $noTagInfo; 7838 $parms{Value} = $val; 7839 $parms{Value} .= " ($rational)" if defined $rational; 7840 $parms{Table} = $tagTablePtr; 7841 if ($format) { 7842 my $count = int(($parms{Size} || 0) / ($formatSize{$format} || 1)); 7843 $parms{Format} = $format . "[$count]"; 7844 } 7845 $self->VerboseInfo($tag, $tagInfo, %parms); 7846 } 7847 if ($tagInfo) { 7848 if ($subdir) { 7849 my $subdirStart = $parms{Start}; 7850 my $subdirLen = $parms{Size}; 7851 if ($$tagInfo{RawConv} and not $$tagInfo{Writable}) { 7852 my $conv = $$tagInfo{RawConv}; 7853 local $SIG{'__WARN__'} = \&SetWarning; 7854 undef $evalWarning; 7855 if (ref $conv eq 'CODE') { 7856 $val = &$conv($val, $self); 7857 } else { 7858 my ($priority, @grps); 7859 # NOTE: RawConv is evaluated in Writer.pl and twice in ExifTool.pm 7860 #### eval RawConv ($self, $val, $tag, $tagInfo, $priority, @grps) 7861 $val = eval $conv; 7862 $@ and $evalWarning = $@; 7863 } 7864 $self->Warn("RawConv $tag: " . CleanWarning()) if $evalWarning; 7865 return undef unless defined $val; 7866 $val = $$val if ref $val eq 'SCALAR'; 7867 $dataPt = \$val; 7868 $subdirStart = 0; 7869 $subdirLen = length $val; 7870 } 7871 if ($$subdir{Start}) { 7872 my $valuePtr = 0; 7873 #### eval Start ($valuePtr) 7874 my $off = eval $$subdir{Start}; 7875 $subdirStart += $off; 7876 $subdirLen -= $off; 7877 } 7878 $dataPt or $dataPt = \$val; 7879 # process subdirectory information 7880 my %dirInfo = ( 7881 DirName => $$subdir{DirName} || $$tagInfo{Name}, 7882 DataPt => $dataPt, 7883 DataLen => length $$dataPt, 7884 DataPos => $parms{DataPos}, 7885 DirStart => $subdirStart, 7886 DirLen => $subdirLen, 7887 Parent => $parms{Parent}, 7888 Base => $parms{Base}, 7889 Multi => $$subdir{Multi}, 7890 TagInfo => $tagInfo, 7891 RAF => $parms{RAF}, 7892 ); 7893 my $oldOrder = GetByteOrder(); 7894 if ($$subdir{ByteOrder}) { 7895 if ($$subdir{ByteOrder} eq 'Unknown') { 7896 if ($subdirStart + 2 <= $subdirLen) { 7897 # attempt to determine the byte ordering of an IFD-style subdirectory 7898 my $num = Get16u($dataPt, $subdirStart); 7899 ToggleByteOrder if $num & 0xff00 and ($num>>8) > ($num&0xff); 7900 } 7901 } else { 7902 SetByteOrder($$subdir{ByteOrder}); 7903 } 7904 } 7905 my $subTablePtr = GetTagTable($$subdir{TagTable}) || $tagTablePtr; 7906 $self->ProcessDirectory(\%dirInfo, $subTablePtr, $$subdir{ProcessProc} || $parms{ProcessProc}); 7907 SetByteOrder($oldOrder); 7908 # return now unless directory is writable as a block 7909 return undef unless $$tagInfo{Writable}; 7910 } 7911 my $key = $self->FoundTag($tagInfo, $val); 7912 # save original components of rational numbers 7913 $$self{RATIONAL}{$key} = $rational if defined $rational and defined $key; 7914 return $key; 7915 } 7916 return undef; 7917} 7918 7919#------------------------------------------------------------------------------ 7920# Add tag to hash of extracted information 7921# Inputs: 0) ExifTool object reference 7922# 1) reference to tagInfo hash or tag name 7923# 2) data value (or reference to require hash if Composite) 7924# 3) optional family 0 group, 4) optional family 1 group 7925# Returns: tag key or undef if no value 7926sub FoundTag($$$;@) 7927{ 7928 local $_; 7929 my ($self, $tagInfo, $value, @grps) = @_; 7930 my ($tag, $noListDel); 7931 my $options = $$self{OPTIONS}; 7932 7933 if (ref $tagInfo eq 'HASH') { 7934 $tag = $$tagInfo{Name} or warn("No tag name\n"), return undef; 7935 } else { 7936 $tag = $tagInfo; 7937 # look for tag in Extra 7938 $tagInfo = $self->GetTagInfo(GetTagTable('Image::ExifTool::Extra'), $tag); 7939 # make temporary hash if tag doesn't exist in Extra 7940 # (not advised to do this since the tag won't show in list) 7941 $tagInfo or $tagInfo = { Name => $tag, Groups => \%allGroupsExifTool }; 7942 $$options{Verbose} and $self->VerboseInfo(undef, $tagInfo, Value => $value); 7943 } 7944 # get tag priority 7945 my $priority = $$tagInfo{Priority}; 7946 unless (defined $priority) { 7947 $priority = $$tagInfo{Table}{PRIORITY}; 7948 $priority = 0 if not defined $priority and $$tagInfo{Avoid}; 7949 } 7950 $grps[0] or $grps[0] = $$self{SET_GROUP0}; 7951 $grps[1] or $grps[1] = $$self{SET_GROUP1}; 7952 my $valueHash = $$self{VALUE}; 7953 7954 if ($$tagInfo{RawConv}) { 7955 # initialize @val for use in Composite RawConv expressions 7956 my @val; 7957 if (ref $value eq 'HASH' and $$tagInfo{IsComposite}) { 7958 foreach (keys %$value) { $val[$_] = $$valueHash{$$value{$_}}; } 7959 } 7960 my $conv = $$tagInfo{RawConv}; 7961 local $SIG{'__WARN__'} = \&SetWarning; 7962 undef $evalWarning; 7963 if (ref $conv eq 'CODE') { 7964 $value = &$conv($value, $self); 7965 $$self{grps} and @grps = @{$$self{grps}}, delete $$self{grps}; 7966 } else { 7967 my $val = $value; # do this so eval can use $val 7968 # NOTE: RawConv is also evaluated in Writer.pl 7969 #### eval RawConv ($self, $val, $tag, $tagInfo, $priority, @grps) 7970 $value = eval $conv; 7971 $@ and $evalWarning = $@; 7972 } 7973 $self->Warn("RawConv $tag: " . CleanWarning()) if $evalWarning; 7974 return undef unless defined $value; 7975 } 7976 # handle duplicate tag names 7977 if (defined $$valueHash{$tag}) { 7978 # add to list if there is an active list for this tag 7979 if ($$self{LIST_TAGS}{$tagInfo}) { 7980 $tag = $$self{LIST_TAGS}{$tagInfo}; # use key from previous list tag 7981 if (defined $$self{NO_LIST}) { 7982 # accumulate list in TAG_EXTRA "NoList" element 7983 if (defined $$self{TAG_EXTRA}{$tag}{NoList}) { 7984 push @{$$self{TAG_EXTRA}{$tag}{NoList}}, $value; 7985 } else { 7986 $$self{TAG_EXTRA}{$tag}{NoList} = [ $$valueHash{$tag}, $value ]; 7987 } 7988 $noListDel = 1; # set flag to delete this tag if re-listed 7989 } else { 7990 if (ref $$valueHash{$tag} ne 'ARRAY') { 7991 $$valueHash{$tag} = [ $$valueHash{$tag} ]; 7992 } 7993 push @{$$valueHash{$tag}}, $value; 7994 return $tag; # return without creating a new entry 7995 } 7996 } 7997 # get next available tag key 7998 my $nextInd = $$self{DUPL_TAG}{$tag} = ($$self{DUPL_TAG}{$tag} || 0) + 1; 7999 my $nextTag = "$tag ($nextInd)"; 8000# 8001# take tag with highest priority 8002# 8003 # promote existing 0-priority tag so it takes precedence over a new 0-tag 8004 # (unless old tag was a sub-document and new tag isn't. Also, never override 8005 # a Warning tag because they may be added by ValueConv, which could be confusing) 8006 my $oldPriority = $$self{PRIORITY}{$tag}; 8007 unless ($oldPriority) { 8008 if ($$self{DOC_NUM} or not $$self{TAG_EXTRA}{$tag} or $tag eq 'Warning' or 8009 not $$self{TAG_EXTRA}{$tag}{G3}) 8010 { 8011 $oldPriority = 1; 8012 } else { 8013 $oldPriority = 0; # don't promote sub-document tag over main document 8014 } 8015 } 8016 # set priority for this tag 8017 if (defined $priority) { 8018 # increase 0-priority tags if this is the priority directory 8019 $priority = 1 if not $priority and $$self{DIR_NAME} and 8020 $$self{DIR_NAME} eq $$self{PRIORITY_DIR}; 8021 } elsif ($$self{LOW_PRIORITY_DIR}{'*'} or 8022 ($$self{DIR_NAME} and $$self{LOW_PRIORITY_DIR}{$$self{DIR_NAME}})) 8023 { 8024 $priority = 0; # default is 0 for a LOW_PRIORITY_DIR 8025 } else { 8026 $priority = 1; # the normal default 8027 } 8028 if ($priority >= $oldPriority and (not $$self{DOC_NUM} or 8029 ($$self{TAG_EXTRA}{$tag} and $$self{TAG_EXTRA}{$tag}{G3} and 8030 $$self{DOC_NUM} eq $$self{TAG_EXTRA}{$tag}{G3})) and not $noListDel) 8031 { 8032 # move existing tag out of the way since this tag is higher priority 8033 # (NOTE: any new members added here must also be added to DeleteTag()) 8034 $$self{PRIORITY}{$nextTag} = $$self{PRIORITY}{$tag}; 8035 $$valueHash{$nextTag} = $$valueHash{$tag}; 8036 $$self{FILE_ORDER}{$nextTag} = $$self{FILE_ORDER}{$tag}; 8037 my $oldInfo = $$self{TAG_INFO}{$nextTag} = $$self{TAG_INFO}{$tag}; 8038 foreach ('TAG_EXTRA','RATIONAL') { 8039 if ($$self{$_}{$tag}) { 8040 $$self{$_}{$nextTag} = $$self{$_}{$tag}; 8041 delete $$self{$_}{$tag}; 8042 } 8043 } 8044 delete $$self{BOTH}{$tag}; 8045 # update tag key for list if necessary 8046 $$self{LIST_TAGS}{$oldInfo} = $nextTag if $$self{LIST_TAGS}{$oldInfo}; 8047 # update this key if used in a Composite tag 8048 if ($$self{COMP_KEYS}{$tag}) { 8049 $$_[0]{$$_[1]} = $nextTag foreach @{$$self{COMP_KEYS}{$tag}}; 8050 $$self{COMP_KEYS}{$nextTag} = $$self{COMP_KEYS}{$tag}; 8051 delete $$self{COMP_KEYS}{$tag}; 8052 } 8053 } else { 8054 $tag = $nextTag; # don't override the existing tag 8055 } 8056 $$self{PRIORITY}{$tag} = $priority; 8057 $$self{TAG_EXTRA}{$tag}{NoListDel} = 1 if $noListDel; 8058 } elsif ($priority) { 8059 # set tag priority (only if exists and is non-zero) 8060 $$self{PRIORITY}{$tag} = $priority; 8061 } 8062 8063 # save the raw value, file order, tagInfo ref, group1 name, 8064 # and tag key for lists if necessary 8065 $$valueHash{$tag} = $value; 8066 $$self{FILE_ORDER}{$tag} = ++$$self{NUM_FOUND}; 8067 $$self{TAG_INFO}{$tag} = $tagInfo; 8068 # set dynamic groups 0, 1 and 3 if necessary 8069 $$self{TAG_EXTRA}{$tag}{G0} = $grps[0] if $grps[0]; 8070 $$self{TAG_EXTRA}{$tag}{G1} = $grps[1] if $grps[1]; 8071 if ($$self{DOC_NUM}) { 8072 $$self{TAG_EXTRA}{$tag}{G3} = $$self{DOC_NUM}; 8073 if ($$self{DOC_NUM} =~ /^(\d+)/) { 8074 # keep track of maximum 1st-level sub-document number 8075 $$self{DOC_COUNT} = $1 unless $$self{DOC_COUNT} >= $1; 8076 } 8077 } 8078 # save path if requested 8079 $$self{TAG_EXTRA}{$tag}{G5} = $self->MetadataPath() if $$options{SavePath}; 8080 8081 # remember this tagInfo if we will be accumulating values in a list 8082 # (but don't override earlier list if this may be deleted by NoListDel flag) 8083 if ($$tagInfo{List} and not $$self{NO_LIST} and not $noListDel) { 8084 $$self{LIST_TAGS}{$tagInfo} = $tag; 8085 } 8086 8087 # validate tag if requested (but only for simple values -- could result 8088 # in infinite recursion if called for a Composite tag (HASH ref value) 8089 # because FoundTag is called in the middle of building Composite tags 8090 if ($$options{Validate} and not ref $value) { 8091 Image::ExifTool::Validate::ValidateRaw($self, $tag, $value); 8092 } 8093 8094 return $tag; 8095} 8096 8097#------------------------------------------------------------------------------ 8098# Make current directory the priority directory if not set already 8099# Inputs: 0) ExifTool object reference 8100sub SetPriorityDir($) 8101{ 8102 my $self = shift; 8103 $$self{PRIORITY_DIR} = $$self{DIR_NAME} unless $$self{PRIORITY_DIR}; 8104} 8105 8106#------------------------------------------------------------------------------ 8107# Set family 0 or 1 group name specific to this tag instance 8108# Inputs: 0) ExifTool ref, 1) tag key, 2) group name, 3) family (default 1) 8109sub SetGroup($$$;$) 8110{ 8111 my ($self, $tagKey, $extra, $fam) = @_; 8112 $$self{TAG_EXTRA}{$tagKey}{defined $fam ? "G$fam" : 'G1'} = $extra; 8113} 8114 8115#------------------------------------------------------------------------------ 8116# Delete specified tag 8117# Inputs: 0) ExifTool object ref, 1) tag key 8118sub DeleteTag($$) 8119{ 8120 my ($self, $tag) = @_; 8121 delete $$self{VALUE}{$tag}; 8122 delete $$self{FILE_ORDER}{$tag}; 8123 delete $$self{TAG_INFO}{$tag}; 8124 delete $$self{TAG_EXTRA}{$tag}; 8125 delete $$self{PRIORITY}{$tag}; 8126 delete $$self{RATIONAL}{$tag}; 8127 delete $$self{BOTH}{$tag}; 8128} 8129 8130#------------------------------------------------------------------------------ 8131# Escape all elements of a value 8132# Inputs: 0) value, 1) escape proc 8133sub DoEscape($$) 8134{ 8135 my ($val, $key); 8136 if (not ref $_[0]) { 8137 $_[0] = &{$_[1]}($_[0]); 8138 } elsif (ref $_[0] eq 'ARRAY') { 8139 foreach $val (@{$_[0]}) { 8140 DoEscape($val, $_[1]); 8141 } 8142 } elsif (ref $_[0] eq 'HASH') { 8143 foreach $key (keys %{$_[0]}) { 8144 DoEscape($_[0]{$key}, $_[1]); 8145 } 8146 } 8147} 8148 8149#------------------------------------------------------------------------------ 8150# Set the FileType and MIMEType tags 8151# Inputs: 0) ExifTool object reference 8152# 1) Optional file type (uses FILE_TYPE if not specified) 8153# 2) Optional MIME type (uses our lookup if not specified) 8154# 3) Optional recommended extension (converted to lower case; uses FileType if undef) 8155# Notes: Will NOT set file type twice (subsequent calls ignored) 8156sub SetFileType($;$$$) 8157{ 8158 my ($self, $fileType, $mimeType, $normExt) = @_; 8159 unless ($$self{VALUE}{FileType} and not $$self{DOC_NUM}) { 8160 my $baseType = $$self{FILE_TYPE}; 8161 my $ext = $$self{FILE_EXT}; 8162 $fileType or $fileType = $baseType; 8163 # handle sub-types which are identified by extension 8164 if (defined $ext and $ext ne $fileType and not $$self{DOC_NUM}) { 8165 my ($f,$e) = @fileTypeLookup{$fileType,$ext}; 8166 if (ref $f eq 'ARRAY' and ref $e eq 'ARRAY' and $$f[0] eq $$e[0]) { 8167 # make sure $fileType was a root type and not another sub-type 8168 $fileType = $ext if $$f[0] eq $fileType or not $fileTypeLookup{$$f[0]}; 8169 } 8170 } 8171 $mimeType or $mimeType = $mimeType{$fileType}; 8172 # use base file type if necessary (except if 'TIFF', which is a special case) 8173 $mimeType = $mimeType{$baseType} unless $mimeType or $baseType eq 'TIFF'; 8174 unless (defined $normExt) { 8175 $normExt = $fileTypeExt{$fileType}; 8176 $normExt = $fileType unless defined $normExt; 8177 } 8178 $$self{FileType} = $fileType; 8179 $self->FoundTag('FileType', $fileType); 8180 $self->FoundTag('FileTypeExtension', uc $normExt); 8181 $self->FoundTag('MIMEType', $mimeType || 'application/unknown'); 8182 } 8183} 8184 8185#------------------------------------------------------------------------------ 8186# Override the FileType and MIMEType tags 8187# Inputs: 0) ExifTool object ref, 1) file type, 2) MIME type, 3) normal extension 8188# Notes: does nothing if FileType was not previously defined (ie. when writing) 8189sub OverrideFileType($$;$$) 8190{ 8191 my ($self, $fileType, $mimeType, $normExt) = @_; 8192 if (defined $$self{VALUE}{FileType} and $fileType ne $$self{VALUE}{FileType}) { 8193 $$self{FileType} = $fileType; 8194 $$self{VALUE}{FileType} = $fileType; 8195 unless (defined $normExt) { 8196 $normExt = $fileTypeExt{$fileType}; 8197 $normExt = $fileType unless defined $normExt; 8198 } 8199 $$self{VALUE}{FileTypeExtension} = uc $normExt; 8200 $mimeType or $mimeType = $mimeType{$fileType}; 8201 $$self{VALUE}{MIMEType} = $mimeType if $mimeType; 8202 if ($$self{OPTIONS}{Verbose}) { 8203 $self->VPrint(0,"$$self{INDENT}FileType [override] = $fileType\n"); 8204 $self->VPrint(0,"$$self{INDENT}FileTypeExtension [override] = $$self{VALUE}{FileTypeExtension}\n"); 8205 $self->VPrint(0,"$$self{INDENT}MIMEType [override] = $mimeType\n") if $mimeType; 8206 } 8207 } 8208} 8209 8210#------------------------------------------------------------------------------ 8211# Modify the value of the MIMEType tag 8212# Inputs: 0) ExifTool object reference, 1) file or MIME type 8213# Notes: combines existing type with new type: ie) a/b + c/d => c/b-d 8214sub ModifyMimeType($;$) 8215{ 8216 my ($self, $mime) = @_; 8217 $mime =~ m{/} or $mime = $mimeType{$mime} or return; 8218 my $old = $$self{VALUE}{MIMEType}; 8219 if (defined $old) { 8220 my ($a, $b) = split '/', $old; 8221 my ($c, $d) = split '/', $mime; 8222 $d =~ s/^x-//; 8223 $$self{VALUE}{MIMEType} = "$c/$b-$d"; 8224 $self->VPrint(0, " Modified MIMEType = $c/$b-$d\n"); 8225 } else { 8226 $self->FoundTag('MIMEType', $mime); 8227 } 8228} 8229 8230#------------------------------------------------------------------------------ 8231# Print verbose output 8232# Inputs: 0) ExifTool ref, 1) verbose level (prints if level > this), 2-N) print args 8233sub VPrint($$@) 8234{ 8235 my $self = shift; 8236 my $level = shift; 8237 if ($$self{OPTIONS}{Verbose} and $$self{OPTIONS}{Verbose} > $level) { 8238 my $out = $$self{OPTIONS}{TextOut}; 8239 print $out @_; 8240 print $out "\n" unless $_[-1] =~ /\n$/; 8241 } 8242} 8243 8244#------------------------------------------------------------------------------ 8245# Print verbose directory information 8246# Inputs: 0) ExifTool object reference, 1) directory name or dirInfo ref 8247# 2) number of entries in directory (or 0 if unknown) 8248# 3) optional size of directory in bytes 8249sub VerboseDir($$;$$) 8250{ 8251 my ($self, $name, $entries, $size) = @_; 8252 return unless $$self{OPTIONS}{Verbose}; 8253 if (ref $name eq 'HASH') { 8254 $size = $$name{DirLen} unless $size; 8255 $name = $$name{Name} || $$name{DirName}; 8256 } 8257 my $indent = substr($$self{INDENT}, 0, -2); 8258 my $out = $$self{OPTIONS}{TextOut}; 8259 my $str = ($entries or defined $entries and not $size) ? " with $entries entries" : ''; 8260 $str .= ", $size bytes" if $size; 8261 print $out "$indent+ [$name directory$str]\n"; 8262} 8263 8264#------------------------------------------------------------------------------ 8265# Verbose dump 8266# Inputs: 0) ExifTool ref, 1) data ref, 2-N) HexDump options 8267sub VerboseDump($$;%) 8268{ 8269 my $self = shift; 8270 my $dataPt = shift; 8271 my $verbose = $$self{OPTIONS}{Verbose}; 8272 if ($verbose and $verbose > 2) { 8273 my %parms = ( 8274 Prefix => $$self{INDENT}, 8275 Out => $$self{OPTIONS}{TextOut}, 8276 MaxLen => $verbose < 4 ? 96 : $verbose < 5 ? 2048 : undef, 8277 ); 8278 HexDump($dataPt, undef, %parms, @_); 8279 } 8280} 8281 8282#------------------------------------------------------------------------------ 8283# Print data in hex 8284# Inputs: 0) data 8285# Returns: hex string 8286# (this is a convenience function for use in debugging PrintConv statements) 8287sub PrintHex($) 8288{ 8289 my $val = shift; 8290 return join(' ', unpack('H2' x length($val), $val)); 8291} 8292 8293#------------------------------------------------------------------------------ 8294# Extract binary data from file 8295# 0) ExifTool object reference, 1) offset, 2) length, 3) tag name if conditional 8296# Returns: binary data, or undef on error 8297# Notes: Returns "Binary data #### bytes" instead of data unless tag is 8298# specifically requested or the Binary option is set 8299sub ExtractBinary($$$;$) 8300{ 8301 my ($self, $offset, $length, $tag) = @_; 8302 my ($isPreview, $buff); 8303 8304 if ($tag) { 8305 if ($tag eq 'PreviewImage') { 8306 # save PreviewImage start/length in case we want to dump trailer 8307 $$self{PreviewImageStart} = $offset; 8308 $$self{PreviewImageLength} = $length; 8309 $isPreview = 1; 8310 } 8311 my $lcTag = lc $tag; 8312 if ((not $$self{OPTIONS}{Binary} or $$self{EXCL_TAG_LOOKUP}{$lcTag}) and 8313 not $$self{OPTIONS}{Verbose} and not $$self{REQ_TAG_LOOKUP}{$lcTag}) 8314 { 8315 return "Binary data $length bytes"; 8316 } 8317 } 8318 unless ($$self{RAF}->Seek($offset,0) 8319 and $$self{RAF}->Read($buff, $length) == $length) 8320 { 8321 $tag or $tag = 'binary data'; 8322 if ($isPreview and not $$self{BuildingComposite}) { 8323 $$self{PreviewError} = 1; 8324 } else { 8325 $self->Warn("Error reading $tag from file", $isPreview); 8326 } 8327 return undef; 8328 } 8329 return $buff; 8330} 8331 8332#------------------------------------------------------------------------------ 8333# Process binary data 8334# Inputs: 0) ExifTool object ref, 1) directory information ref, 2) tag table ref 8335# Returns: 1 on success 8336# Notes: dirInfo may contain VarFormatData (reference to empty list) to return 8337# details about any variable-length-format tags in the table (used when writing) 8338sub ProcessBinaryData($$$) 8339{ 8340 my ($self, $dirInfo, $tagTablePtr) = @_; 8341 my $dataPt = $$dirInfo{DataPt}; 8342 my $offset = $$dirInfo{DirStart} || 0; 8343 my $size = $$dirInfo{DirLen} || (length($$dataPt) - $offset); 8344 my $base = $$dirInfo{Base} || 0; 8345 my $verbose = $$self{OPTIONS}{Verbose}; 8346 my $unknown = $$self{OPTIONS}{Unknown}; 8347 my $dataPos = $$dirInfo{DataPos} || 0; 8348 8349 # get default format ('int8u' unless specified) 8350 my $defaultFormat = $$tagTablePtr{FORMAT} || 'int8u'; 8351 my $increment = $formatSize{$defaultFormat}; 8352 unless ($increment) { 8353 warn "Unknown format $defaultFormat\n"; 8354 $defaultFormat = 'int8u'; 8355 $increment = $formatSize{$defaultFormat}; 8356 } 8357 # prepare list of tag numbers to extract 8358 my (@tags, $topIndex); 8359 if ($unknown > 1 and defined $$tagTablePtr{FIRST_ENTRY}) { 8360 # don't create a stupid number of tags if data is huge 8361 my $sizeLimit = $size < 65536 ? $size : 65536; 8362 # scan through entire binary table 8363 $topIndex = int($sizeLimit/$increment); 8364 @tags = ($$tagTablePtr{FIRST_ENTRY}..($topIndex - 1)); 8365 # add in floating point tag ID's if they exist 8366 my @ftags = grep /\./, TagTableKeys($tagTablePtr); 8367 @tags = sort { $a <=> $b } @tags, @ftags if @ftags; 8368 } elsif ($$dirInfo{DataMember}) { 8369 @tags = @{$$dirInfo{DataMember}}; 8370 $verbose = 0; # no verbose output of extracted values when writing 8371 } elsif ($$dirInfo{MixedTags}) { 8372 # process sorted integer-ID tags only 8373 @tags = sort { $a <=> $b } grep /^\d+$/, TagTableKeys($tagTablePtr); 8374 } else { 8375 # extract known tags in numerical order 8376 @tags = sort { ($a < 0 ? $a + 1e9 : $a) <=> ($b < 0 ? $b + 1e9 : $b) } TagTableKeys($tagTablePtr); 8377 } 8378 $self->VerboseDir('BinaryData', undef, $size) if $verbose; 8379 # avoid creating unknown tags for tags that fail condition if Unknown is 1 8380 $$self{NO_UNKNOWN} = 1 if $unknown < 2; 8381 my ($index, %val); 8382 my $nextIndex = 0; 8383 my $varSize = 0; 8384 foreach $index (@tags) { 8385 my ($tagInfo, $val, $saveNextIndex, $len, $mask, $wasVar, $rational); 8386 if ($$tagTablePtr{$index}) { 8387 $tagInfo = $self->GetTagInfo($tagTablePtr, $index); 8388 unless ($tagInfo) { 8389 next unless defined $tagInfo; 8390 my $entry = int($index) * $increment + $varSize; 8391 if ($entry < 0) { 8392 $entry += $size; 8393 next if $entry < 0; 8394 } 8395 next if $entry >= $size; 8396 my $more = $size - $entry; 8397 $more = 128 if $more > 128; 8398 my $v = substr($$dataPt, $entry+$offset, $more); 8399 $tagInfo = $self->GetTagInfo($tagTablePtr, $index, \$v); 8400 next unless $tagInfo; 8401 } 8402 next if $$tagInfo{Unknown} and 8403 ($$tagInfo{Unknown} > $unknown or $index < $nextIndex); 8404 } elsif ($topIndex and $$tagTablePtr{$index - $topIndex}) { 8405 $tagInfo = $self->GetTagInfo($tagTablePtr, $index - $topIndex) or next; 8406 } else { 8407 # don't generate unknown tags in binary tables unless Unknown > 1 8408 next unless $unknown > 1; 8409 next if $index < $nextIndex; # skip if data already used 8410 $tagInfo = $self->GetTagInfo($tagTablePtr, $index) or next; 8411 $$tagInfo{Unknown} = 2; # set unknown to 2 for binary unknowns 8412 } 8413 # get relative offset of this entry 8414 my $entry = int($index) * $increment + $varSize; 8415 # allow negative indices to represent bytes from end 8416 if ($entry < 0) { 8417 $entry += $size; 8418 next if $entry < 0; 8419 } 8420 my $more = $size - $entry; 8421 last if $more <= 0; # all done if we have reached the end of data 8422 my $count = 1; 8423 my $format = $$tagInfo{Format}; 8424 if (not $format) { 8425 $format = $defaultFormat; 8426 } elsif ($format eq 'string') { 8427 # string with no specified count runs to end of block 8428 $count = $more; 8429 } elsif ($format eq 'pstring') { 8430 $format = 'string'; 8431 $count = Get8u($dataPt, ($entry++)+$offset); 8432 --$more; 8433 } elsif (not $formatSize{$format}) { 8434 if ($format =~ /(.*)\[(.*)\]/) { 8435 # handle format count field 8436 $format = $1; 8437 $count = $2; 8438 # evaluate count to allow count to be based on previous values 8439 #### eval Format size (%val, $size, $self) 8440 $count = eval $count; 8441 $@ and warn("Format $$tagInfo{Name}: $@"), next; 8442 next if $count < 0; 8443 # allow a variable-length value of any format 8444 # (note: the next incremental index points to data immediately after 8445 # this value, regardless of the size of this value, even if it is zero) 8446 if ($format =~ s/^var_//) { 8447 $varSize += $count * ($formatSize{$format} || 1) - $increment; 8448 $wasVar = 1; 8449 # save variable size data if required for writing 8450 if ($$dirInfo{VarFormatData}) { 8451 push @{$$dirInfo{VarFormatData}}, [ $index, $varSize, $format ]; 8452 } 8453 # don't extract value if large and we wanted it just to get 8454 # the variable-format information when writing 8455 next if $$tagInfo{LargeTag} and $$dirInfo{VarFormatData}; 8456 } 8457 } elsif ($format =~ /^var_/) { 8458 # handle variable-length string formats 8459 $format = substr($format, 4); 8460 pos($$dataPt) = $entry + $offset; 8461 undef $count; 8462 if ($format eq 'ustring') { 8463 $count = pos($$dataPt) - ($entry+$offset) if $$dataPt =~ /\G(..)*?\0\0/sg; 8464 $varSize -= 2; # ($count includes base size of 2 bytes) 8465 } elsif ($format eq 'pstring') { 8466 $count = Get8u($dataPt, ($entry++)+$offset); 8467 --$more; 8468 } elsif ($format eq 'pstr32' or $format eq 'ustr32') { 8469 last if $more < 4; 8470 $count = Get32u($dataPt, $entry + $offset); 8471 $count *= 2 if $format eq 'ustr32'; 8472 $entry += 4; 8473 $more -= 4; 8474 $nextIndex += 4 / $increment; # (increment next index for int32u) 8475 } elsif ($format eq 'int16u') { 8476 # int16u size of binary data to follow 8477 last if $more < 2; 8478 $count = Get16u($dataPt, $entry + $offset) + 2; 8479 $varSize -= 2; # ($count includes size word) 8480 $format = 'undef'; 8481 } elsif ($format eq 'ue7') { 8482 require Image::ExifTool::BPG; 8483 ($val, $count) = Image::ExifTool::BPG::Get_ue7($dataPt, $entry + $offset); 8484 last unless defined $val; 8485 --$varSize; # ($count includes base size of 1 byte) 8486 } elsif ($$dataPt =~ /\0/g) { 8487 $count = pos($$dataPt) - ($entry+$offset); 8488 --$varSize; # ($count includes base size of 1 byte) 8489 } 8490 $count = $more if not defined $count or $count > $more; 8491 $varSize += $count; # shift subsequent indices 8492 unless (defined $val) { 8493 $val = substr($$dataPt, $entry+$offset, $count); 8494 $val = $self->Decode($val, 'UCS2') if $format eq 'ustring' or $format eq 'ustr32'; 8495 $val =~ s/\0.*//s unless $format eq 'undef'; # truncate at null 8496 } 8497 $wasVar = 1; 8498 # save variable size data if required for writing 8499 if ($$dirInfo{VarFormatData}) { 8500 push @{$$dirInfo{VarFormatData}}, [ $index, $varSize, $format ]; 8501 } 8502 } 8503 } 8504 # hook to allow format, etc to be set dynamically 8505 if (defined $$tagInfo{Hook}) { 8506 my $oldVarSize = $varSize; 8507 my $pos = $entry + $offset; 8508 #### eval Hook ($format, $varSize, $size, $dataPt, $pos) 8509 eval $$tagInfo{Hook}; 8510 # save variable size data if required for writing (in case changed by Hook) 8511 if ($$dirInfo{VarFormatData}) { 8512 $#{$$dirInfo{VarFormatData}} -= 1 if $wasVar; # remove previous entry for this tag 8513 push @{$$dirInfo{VarFormatData}}, [ $index, $varSize, $format ]; 8514 } elsif ($varSize != $oldVarSize and $verbose > 2) { 8515 my ($tmp, $sign) = ($varSize, '+'); 8516 $tmp < 0 and $tmp = -$tmp, $sign = '-'; 8517 $self->VPrint(2, sprintf("$$self{INDENT}\[offsets adjusted by ${sign}0x%.4x after 0x%.4x $$tagInfo{Name}]\n", $tmp, $index)); 8518 } 8519 } 8520 if ($unknown > 1) { 8521 # calculate next valid index for unknown tag 8522 my $ni = int $index; 8523 $ni += (($formatSize{$format} || 1) * $count) / $increment unless $wasVar; 8524 $saveNextIndex = $nextIndex; 8525 $nextIndex = $ni unless $nextIndex > $ni; 8526 } 8527 # allow large tags to be excluded from extraction 8528 # (provides a work-around for some tight memory situations) 8529 next if $$tagInfo{LargeTag} and $$self{EXCL_TAG_LOOKUP}{lc $$tagInfo{Name}}; 8530 # read value now if necessary 8531 unless (defined $val and not $$tagInfo{SubDirectory}) { 8532 $val = ReadValue($dataPt, $entry+$offset, $format, $count, $more, \$rational); 8533 $mask = $$tagInfo{Mask}; 8534 $val = ($val & $mask) >> $$tagInfo{BitShift} if $mask; 8535 } 8536 if ($verbose and not $$tagInfo{Hidden}) { 8537 if (not $$tagInfo{SubDirectory} or $$tagInfo{Format}) { 8538 $len = $count * ($formatSize{$format} || 1); 8539 $len = $more if $len > $more; 8540 } else { 8541 $len = $more; 8542 } 8543 $self->VerboseInfo($index, $tagInfo, 8544 Table => $tagTablePtr, 8545 Value => $val, 8546 DataPt => $dataPt, 8547 Size => $len, 8548 Start => $entry+$offset, 8549 Addr => $entry+$offset+$base+$dataPos, 8550 Format => $format, 8551 Count => $count, 8552 Extra => $mask ? sprintf(', mask 0x%.2x',$mask) : undef, 8553 ); 8554 } 8555 # parse nested BinaryData directories 8556 if ($$tagInfo{SubDirectory}) { 8557 my $subdir = $$tagInfo{SubDirectory}; 8558 my $subTablePtr = GetTagTable($$subdir{TagTable}); 8559 # use specified subdirectory length if given 8560 if ($$tagInfo{Format} and $formatSize{$format}) { 8561 $len = $count * $formatSize{$format}; 8562 $len = $more if $len > $more; 8563 } else { 8564 $len = $more; # directory size is all of remaining data 8565 if ($$subTablePtr{PROCESS_PROC} and 8566 $$subTablePtr{PROCESS_PROC} eq \&ProcessBinaryData) 8567 { 8568 # the rest of the data will be printed in the subdirectory 8569 $nextIndex = $size / $increment; 8570 } 8571 } 8572 my $subdirBase = $base; 8573 if (defined $$subdir{Base}) { 8574 #### eval Base ($start,$base) 8575 my $start = $entry + $offset + $dataPos; 8576 $subdirBase = eval($$subdir{Base}) + $base; 8577 } 8578 my $start = $$subdir{Start} || 0; 8579 my %subdirInfo = ( 8580 DataPt => $dataPt, 8581 DataPos => $dataPos, 8582 DataLen => length $$dataPt, 8583 DirStart => $entry + $offset + $start, 8584 DirLen => $len - $start, 8585 Base => $subdirBase, 8586 ); 8587 delete $$self{NO_UNKNOWN}; 8588 $self->ProcessDirectory(\%subdirInfo, $subTablePtr, $$subdir{ProcessProc}); 8589 $$self{NO_UNKNOWN} = 1 if $unknown < 2; 8590 next; 8591 } 8592 if ($$tagInfo{IsOffset} and $$tagInfo{IsOffset} ne '3') { 8593 my $et = $self; 8594 #### eval IsOffset ($val, $et) 8595 $val += $base + $$self{BASE} if eval $$tagInfo{IsOffset}; 8596 } 8597 $val{$index} = $val; 8598 my $oldBase; 8599 if ($$tagInfo{SetBase}) { 8600 $oldBase = $$self{BASE}; 8601 $$self{BASE} += $base; 8602 } 8603 my $key = $self->FoundTag($tagInfo,$val); 8604 $$self{BASE} = $oldBase if defined $oldBase; 8605 if ($key) { 8606 $$self{RATIONAL}{$key} = $rational if defined $rational; 8607 } else { 8608 # don't increment nextIndex if we didn't extract a tag 8609 $nextIndex = $saveNextIndex if defined $saveNextIndex; 8610 } 8611 } 8612 delete $$self{NO_UNKNOWN}; 8613 return 1; 8614} 8615 8616#.............................................................................. 8617# Load .ExifTool_config file from user's home directory 8618# (use of noConfig is now deprecated, use configFile = '' instead) 8619until ($Image::ExifTool::noConfig) { 8620 my $config = $Image::ExifTool::configFile; 8621 my $file; 8622 if (not defined $config) { 8623 $config = '.ExifTool_config'; 8624 # get our home directory (HOMEDRIVE and HOMEPATH are used in Windows cmd shell) 8625 my $home = $ENV{EXIFTOOL_HOME} || $ENV{HOME} || 8626 ($ENV{HOMEDRIVE} || '') . ($ENV{HOMEPATH} || '') || '.'; 8627 # look for the config file in 1) the home directory, 2) the program dir 8628 $file = "$home/$config"; 8629 } else { 8630 length $config or last; # filename of "" disables configuration 8631 $file = $config; 8632 } 8633 # also check executable directory unless path is absolute 8634 $exePath = $0 unless defined $exePath; # (undocumented $exePath setting) 8635 -r $file or $config =~ /^\// or $file = ($exePath =~ /(.*[\\\/])/ ? $1 : './') . $config; 8636 unless (-r $file) { 8637 warn("Config file not found\n") if defined $Image::ExifTool::configFile; 8638 last; 8639 } 8640 unshift @INC, '.'; # look in current directory first 8641 eval { require $file }; # load the config file 8642 shift @INC; 8643 # print warning (minus "Compilation failed" part) 8644 $@ and $_=$@, s/Compilation failed.*//s, warn $_; 8645 last; 8646} 8647# read user-defined lenses (may have been defined by script instead of config file) 8648if (@Image::ExifTool::UserDefined::Lenses) { 8649 foreach (@Image::ExifTool::UserDefined::Lenses) { 8650 $Image::ExifTool::userLens{$_} = 1; 8651 } 8652} 8653# add user-defined file types 8654if (%Image::ExifTool::UserDefined::FileTypes) { 8655 foreach (sort keys %Image::ExifTool::UserDefined::FileTypes) { 8656 my $fileInfo = $Image::ExifTool::UserDefined::FileTypes{$_}; 8657 my $type = uc $_; 8658 ref $fileInfo eq 'HASH' or $fileTypeLookup{$type} = $fileInfo, next; 8659 my $baseType = $$fileInfo{BaseType}; 8660 if ($baseType) { 8661 if ($$fileInfo{Description}) { 8662 $fileTypeLookup{$type} = [ $baseType, $$fileInfo{Description} ]; 8663 } else { 8664 $fileTypeLookup{$type} = $baseType; 8665 } 8666 if (defined $$fileInfo{Writable} and not $$fileInfo{Writable}) { 8667 # first make sure we are using an actual base type and not a derived type 8668 $baseType = $fileTypeLookup{$baseType} while $baseType and not ref $fileTypeLookup{$baseType}; 8669 # mark this type as not writable 8670 $noWriteFile{$baseType} or $noWriteFile{$baseType} = [ ]; 8671 push @{$noWriteFile{$baseType}}, $type; 8672 } 8673 } else { 8674 $fileTypeLookup{$type} = [ $type, $$fileInfo{Description} || $type ]; 8675 $moduleName{$type} = 0; # not supported 8676 if ($$fileInfo{Magic}) { 8677 $magicNumber{$type} = $$fileInfo{Magic}; 8678 push @fileTypes, $type unless grep /^$type$/, @fileTypes; 8679 } 8680 } 8681 $mimeType{$type} = $$fileInfo{MIMEType} if defined $$fileInfo{MIMEType}; 8682 } 8683} 8684 8685#------------------------------------------------------------------------------ 86861; # end 8687