Changeset 34921 for main/trunk/greenstone2/perllib/cpan/Image/ExifTool.pm
- Timestamp:
- 2021-02-26T19:39:51+13:00 (3 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
main/trunk/greenstone2/perllib/cpan/Image/ExifTool.pm
r24107 r34921 4 4 # Description: Read and write meta information 5 5 # 6 # URL: http ://owl.phy.queensu.ca/~phil/exiftool/6 # URL: https://exiftool.org/ 7 7 # 8 8 # Revisions: Nov. 12/2003 - P. Harvey Created 9 9 # (See html/history.html for revision history) 10 10 # 11 # Legal: Copyright (c) 2003-20 10, Phil Harvey (phil at owl.phy.queensu.ca)11 # Legal: Copyright (c) 2003-2021, Phil Harvey (philharvey66 at gmail.com) 12 12 # This library is free software; you can redistribute it and/or 13 13 # modify it under the same terms as Perl itself. … … 20 20 require Exporter; 21 21 use File::RandomAccess; 22 23 use vars qw($VERSION $RELEASE @ISA %EXPORT_TAGS $AUTOLOAD @fileTypes %allTables 24 @tableOrder $exifAPP1hdr $xmpAPP1hdr $xmpExtAPP1hdr $psAPP13hdr 25 $psAPP13old @loadAllTables %UserDefined $evalWarning %noWriteFile 26 %magicNumber @langs $defaultLang %langName %charsetName %mimeType 27 $swapBytes $swapWords $currentByteOrder %unpackStd); 28 29 $VERSION = '8.57'; 22 use overload; 23 24 use 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.19'; 30 32 $RELEASE = ''; 31 33 @ISA = qw(Exporter); … … 35 37 ImageInfo GetTagName GetShortcuts GetAllTags GetWritableTags 36 38 GetAllGroups GetDeleteGroups GetFileType CanWrite CanCreate 39 AddUserDefinedTags 37 40 )], 38 41 # exports not part of the public API, but used by ExifTool modules: … … 40 43 ReadValue GetByteOrder SetByteOrder ToggleByteOrder Get8u Get8s Get16u 41 44 Get16s Get32u Get32s Get64u GetFloat GetDouble GetFixed32s Write 42 WriteValue Tell Set8u Set8s Set16u Set32u 45 WriteValue Tell Set8u Set8s Set16u Set32u Set64u 43 46 )], 44 Utils => [qw(GetTagTable TagTableKeys GetTagInfoList )],47 Utils => [qw(GetTagTable TagTableKeys GetTagInfoList AddTagToTable HexDump)], 45 48 Vars => [qw(%allTables @tableOrder @fileTypes)], 46 49 ); 50 47 51 # set all of our EXPORT_TAGS in EXPORT_OK 48 52 Exporter::export_ok_tags(keys %EXPORT_TAGS); … … 51 55 { my $t = "\xff"; die "Incompatible encoding!\n" if ord($t) != 0xff; } 52 56 53 # The following functions defined in Image::ExifTool::Writer are declared57 # The following functions defined in Image::ExifTool::Writer.pl are declared 54 58 # here so their prototypes will be available. These Writer routines will be 55 59 # autoloaded when any of them is called. 56 60 sub SetNewValue($;$$%); 57 61 sub SetNewValuesFromFile($$;@); 58 sub GetNewValues($;$$); 62 sub GetNewValue($$;$); 63 sub GetNewValues($$;$); 59 64 sub CountNewValues($); 60 65 sub SaveNewValues($); 61 66 sub RestoreNewValues($); 62 67 sub WriteInfo($$;$$); 63 sub SetFileModifyDate($$;$); 64 sub SetFileName($$;$); 68 sub SetFileModifyDate($$;$$$); 69 sub SetFileName($$;$$$); 70 sub SetSystemTags($$); 65 71 sub GetAllTags(;$); 66 72 sub GetWritableTags(;$); 67 sub GetAllGroups($ );73 sub GetAllGroups($;$); 68 74 sub GetNewGroups($); 69 75 sub GetDeleteGroups(); 76 sub AddUserDefinedTags($%); 70 77 # non-public routines below 71 sub InsertTagValues($$$;$ );78 sub InsertTagValues($$$;$$$); 72 79 sub IsWritable($); 80 sub IsSameFile($$$); 81 sub IsRawType($); 73 82 sub GetNewFileName($$); 74 sub NextTagKey($$);75 83 sub LoadAllTables(); 76 84 sub GetNewTagInfoList($;$); … … 79 87 sub Get64s($$); 80 88 sub Get64u($$); 89 sub GetFixed64s($$); 81 90 sub GetExtended($$); 91 sub Set64u(@); 82 92 sub DecodeBits($$;$); 83 93 sub EncodeBits($$;$$); 94 sub Filter($$$); 84 95 sub HexDump($;$%); 85 96 sub DumpTrailer($$); 86 97 sub DumpUnknownTrailer($$); 87 98 sub VerboseInfo($$$%); 88 sub VerboseDir($$;$$);89 99 sub VerboseValue($$$;$); 90 100 sub VPrint($$@); … … 101 111 sub PackUTF8(@); 102 112 sub UnpackUTF8($); 103 sub SetPreferredByteOrder($ );113 sub SetPreferredByteOrder($;$); 104 114 sub CopyBlock($$$); 105 sub CopyFileAttrs($$); 115 sub CopyFileAttrs($$$); 116 sub TimeNow(;$$); 117 sub NewGUID(); 118 sub MakeTiffHeader($$$$;$$); 106 119 107 120 # other subroutine definitions 121 sub SplitFileName($); 122 sub EncodeFileName($$;$); 123 sub Open($*$;$); 124 sub Exists($$); 125 sub IsDirectory($$); 126 sub Rename($$$); 127 sub Unlink($@); 128 sub SetFileTime($$;$$$$); 108 129 sub DoEscape($$); 109 130 sub ConvertFileSize($); 110 131 sub ParseArguments($;@); #(defined in attempt to avoid mod_perl problem) 132 sub ReadValue($$$;$$$); 111 133 112 134 # list of main tag tables to load in LoadAllTables() (sub-tables are recursed … … 114 136 # unless tweaked in BuildTagLookup::GetTableOrder(). 115 137 @loadAllTables = qw( 116 PhotoMechanic Exif GeoTiff CanonRaw KyoceraRaw MinoltaRaw PanasonicRaw 117 SigmaRaw JPEG GIMP Jpeg2000 GIF BMP BMP::OS2 PICT PNG MNG DjVu PGF MIFF PSP 118 PDF PostScript Photoshop::Header FujiFilm::RAF Sony::SRF2 Sony::SR2SubIFD 119 Sony::PMP ITC ID3 Vorbis FLAC APE APE::NewHeader APE::OldHeader MPC 120 MPEG::Audio MPEG::Video MPEG::Xing M2TS QuickTime QuickTime::ImageFile 121 Matroska MXF DV Flash Flash::FLV Real::Media Real::Audio Real::Metafile RIFF 122 AIFF ASF DICOM MIE HTML XMP::SVG EXE EXE::PEVersion EXE::PEString EXE::MachO 123 EXE::PEF EXE::ELF LNK Font RSRC Rawzor ZIP ZIP::GZIP ZIP::RAR RTF OOXML 124 iWork 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 125 152 ); 126 153 127 154 # alphabetical list of current Lang modules 128 @langs = qw(cs de en en_ca en_gb es f r it ja ko nl pl ru sv tr zh_cn zh_tw);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); 129 156 130 157 $defaultLang = 'en'; # default language … … 138 165 en_gb => 'British English', 139 166 es => 'Spanish (Español)', 167 fi => 'Finnish (Suomi)', 140 168 fr => 'French (Français)', 141 169 it => 'Italian (Italiano)', … … 154 182 # Notes: 1) There is no need to test for like types separately here 155 183 # 2) Put types with weak file signatures at end of list to avoid false matches 156 @fileTypes = qw(JPEG CRW TIFF GIF MRW RAF X3F JP2 PNG MIE MIFF PS PDF PSD XMP 157 BMP PPM RIFF AIFF ASF MOV MPEG Real SWF PSP FLV OGG FLAC APE MPC 158 MKV MXF DV PMP IND PGF ICC ITC HTML VRD RTF XCF QTIF FPX PICT 159 ZIP GZIP RAR BZ2 TAR RWZ EXE LNK RAW Font RSRC M2TS MP3 DICM); 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); 160 193 161 194 # file types that we can write (edit) 162 my @writeTypes = qw(JPEG TIFF GIF CRW MRW ORF RAF RAW PNG MIE PSD XMP PPM 163 EPS X3F PS PDF ICC VRD JP2 EXIF AI AIT IND); 195 my @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); 197 my %writeTypes; # lookup for writable file types (hash filled if required) 164 198 165 199 # file extensions that we can't write for various base types 166 200 %noWriteFile = ( 167 201 TIFF => [ qw(3FR DCR K25 KDC SRF) ], 168 XMP => [ 'SVG' ], 202 XMP => [ qw(SVG INX) ], 203 JP2 => [ qw(J2C JPC) ], 204 MOV => [ qw(INSV) ], 169 205 ); 170 206 171 207 # file types that we can create from scratch 172 208 # - must update CanCreate() documentation if this list is changed! 173 my %createTypes = (XMP=>1, ICC=>1, MIE=>1, VRD=>1, EXIF=>1); 174 175 # file type lookup for all recognized file extensions 176 my %fileTypeLookup = ( 209 my %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'], 177 216 '3FR' => ['TIFF', 'Hasselblad RAW format'], 178 217 '3G2' => ['MOV', '3rd Gen. Partnership Project 2 audio/video'], … … 180 219 '3GP2'=> '3G2', 181 220 '3GPP'=> '3GP', 182 ACR => ['DICM', 'American College of Radiology ACR-NEMA'], 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'], 183 226 ACFM => ['Font', 'Adobe Composite Font Metrics'], 184 227 AFM => ['Font', 'Adobe Font Metrics'], … … 189 232 AIFF => ['AIFF', 'Audio Interchange File Format'], 190 233 AIT => 'AI', 234 ALIAS=> ['ALIAS','MacOS file alias'], 191 235 APE => ['APE', "Monkey's Audio format"], 236 APNG => ['PNG', 'Animated Portable Network Graphics'], 192 237 ARW => ['TIFF', 'Sony Alpha RAW format'], 238 ARQ => ['TIFF', 'Sony Alpha Pixel-Shift RAW format'], 193 239 ASF => ['ASF', 'Microsoft Advanced Systems Format'], 240 AVC => ['AVC', 'Advanced Video Connection'], # (extensions are actually _AU,_AD,_IM,_ID) 194 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', 195 245 BMP => ['BMP', 'Windows Bitmap'], 246 BPG => ['BPG', 'Better Portable Graphics'], 196 247 BTF => ['BTF', 'Big Tagged Image File Format'], #(unofficial) 197 248 BZ2 => ['BZ2', 'BZIP2 archive'], 249 CHM => ['CHM', 'Microsoft Compiled HTML format'], 198 250 CIFF => ['CRW', 'Camera Image File Format'], 199 251 COS => ['COS', 'Capture One Settings'], 200 252 CR2 => ['TIFF', 'Canon RAW 2 format'], 253 CR3 => ['MOV', 'Canon RAW 3 format'], 254 CRM => ['MOV', 'Canon RAW Movie'], 201 255 CRW => ['CRW', 'Canon RAW format'], 202 256 CS1 => ['PSD', 'Sinar CaptureShop 1-Shot RAW'], 257 CSV => ['TXT', 'Comma-Separated Values'], 258 CZI => ['CZI', 'Zeiss Integrated Software RAW'], 203 259 DC3 => 'DICM', 204 260 DCM => 'DICM', 205 261 DCP => ['TIFF', 'DNG Camera Profile'], 206 262 DCR => ['TIFF', 'Kodak Digital Camera RAW'], 263 DCX => ['DCX', 'Multi-page PC Paintbrush'], 264 DEX => ['DEX', 'Dalvik Executable format'], 207 265 DFONT=> ['Font', 'Macintosh Data fork Font'], 208 266 DIB => ['BMP', 'Device Independent Bitmap'], 209 267 DIC => 'DICM', 210 DICM => ['DICM', 'Digital Imaging and Communications in Medicine'], 268 DICM => ['DICOM','Digital Imaging and Communications in Medicine'], 269 DIR => ['DIR', 'Directory'], 211 270 DIVX => ['ASF', 'DivX media format'], 212 271 DJV => 'DJVU', … … 223 282 DOTM => [['ZIP','FPX'], 'Office Open XML Document Template Macro-enabled'], 224 283 DOTX => [['ZIP','FPX'], 'Office Open XML Document Template'], 284 DPX => ['DPX', 'Digital Picture Exchange' ], 285 DR4 => ['DR4', 'Canon VRD version 4 Recipe'], 286 DS2 => ['DSS', 'Digital Speech Standard 2'], 287 DSS => ['DSS', 'Digital Speech Standard'], 225 288 DV => ['DV', 'Digital Video'], 226 289 DVB => ['MOV', 'Digital Video Broadcasting'], 290 'DVR-MS'=>['ASF', 'Microsoft Digital Video recording'], 291 DWF => ['DWF', 'Autodesk drawing (Design Web Format)'], 292 DWG => ['DWG', 'AutoCAD Drawing'], 227 293 DYLIB=> ['EXE', 'Mach-O Dynamic Link Library'], 228 294 EIP => ['ZIP', 'Capture One Enhanced Image Package'], … … 231 297 EPS3 => 'EPS', 232 298 EPSF => 'EPS', 299 EPUB => ['ZIP', 'Electronic Publication'], 233 300 ERF => ['TIFF', 'Epson Raw Format'], 234 301 EXE => ['EXE', 'Windows executable file'], 302 EXR => ['EXR', 'Open EXR'], 235 303 EXIF => ['EXIF', 'Exchangable Image File Metadata'], 304 EXV => ['EXV', 'Exiv2 metadata'], 236 305 F4A => ['MOV', 'Adobe Flash Player 9+ Audio'], 237 306 F4B => ['MOV', 'Adobe Flash Player 9+ audio Book'], 238 307 F4P => ['MOV', 'Adobe Flash Player 9+ Protected'], 239 308 F4V => ['MOV', 'Adobe Flash Player 9+ Video'], 309 FFF => [['TIFF','FLIR'], 'Hasselblad Flexible File Format'], 310 FIT => 'FITS', 311 FITS => ['FITS', 'Flexible Image Transport System'], 240 312 FLAC => ['FLAC', 'Free Lossless Audio Codec'], 241 313 FLA => ['FPX', 'Macromedia/Adobe Flash project'], 314 FLIF => ['FLIF', 'Free Lossless Image Format'], 315 FLIR => ['FLIR', 'FLIR File Format'], # (not an actual extension) 242 316 FLV => ['FLV', 'Flash Video'], 317 FPF => ['FPF', 'FLIR Public image Format'], 243 318 FPX => ['FPX', 'FlashPix'], 244 319 GIF => ['GIF', 'Compuserve Graphics Interchange Format'], 320 GPR => ['TIFF', 'GoPro RAW'], 245 321 GZ => 'GZIP', 246 322 GZIP => ['GZIP', 'GNU ZIP compressed archive'], 247 323 HDP => ['TIFF', 'Windows HD Photo'], 324 HDR => ['HDR', 'Radiance RGBE High Dynamic Range'], 325 HEIC => ['MOV', 'High Efficiency Image Format still image'], 326 HEIF => ['MOV', 'High Efficiency Image Format'], 327 HIF => 'HEIF', 248 328 HTM => 'HTML', 249 329 HTML => ['HTML', 'HyperText Markup Language'], 330 ICAL => 'ICS', 250 331 ICC => ['ICC', 'International Color Consortium'], 251 332 ICM => 'ICC', 333 ICS => ['VCard','iCalendar Schedule'], 334 IDML => ['ZIP', 'Adobe InDesign Markup Language'], 252 335 IIQ => ['TIFF', 'Phase One Intelligent Image Quality RAW'], 253 336 IND => ['IND', 'Adobe InDesign'], 254 337 INDD => ['IND', 'Adobe InDesign Document'], 255 338 INDT => ['IND', 'Adobe InDesign Template'], 339 INSV => ['MOV', 'Insta360 Video'], 340 INSP => ['JPEG', 'Insta360 Picture'], 341 INX => ['XMP', 'Adobe InDesign Interchange'], 342 ISO => ['ISO', 'ISO 9660 disk image'], 256 343 ITC => ['ITC', 'iTunes Cover Flow'], 344 J2C => ['JP2', 'JPEG 2000 codestream'], 345 J2K => 'J2C', 257 346 JNG => ['PNG', 'JPG Network Graphics'], 258 347 JP2 => ['JP2', 'JPEG 2000 file'], 259 348 # JP4? - looks like a JPEG but the image data is different 260 JPEG => 'JPG', 261 JPG => ['JPEG', 'Joint Photographic Experts Group'], 349 JPC => 'J2C', 350 JPE => 'JPEG', 351 JPEG => ['JPEG', 'Joint Photographic Experts Group'], 352 JPF => 'JP2', 353 JPG => 'JPEG', 262 354 JPM => ['JP2', 'JPEG 2000 compound image'], 263 355 JPX => ['JP2', 'JPEG 2000 with extensions'], 356 JSON => ['JSON', 'JavaScript Object Notation'], 357 JXR => ['TIFF', 'JPEG XR'], 264 358 K25 => ['TIFF', 'Kodak DC25 RAW'], 265 359 KDC => ['TIFF', 'Kodak Digital Camera RAW'], 266 360 KEY => ['ZIP', 'Apple Keynote presentation'], 267 361 KTH => ['ZIP', 'Apple Keynote Theme'], 362 LA => ['RIFF', 'Lossless Audio'], 363 LFP => ['LFP', 'Lytro Light Field Picture'], 364 LFR => 'LFP', # (Light Field RAW) 268 365 LNK => ['LNK', 'Windows shortcut'], 366 LRI => ['LRI', 'Light RAW'], 367 LRV => ['MOV', 'Low-Resolution Video'], 269 368 M2T => 'M2TS', 270 369 M2TS => ['M2TS', 'MPEG-2 Transport Stream'], … … 274 373 M4P => ['MOV', 'MPEG-4 Protected'], 275 374 M4V => ['MOV', 'MPEG-4 Video'], 375 MAX => ['FPX', '3D Studio MAX'], 276 376 MEF => ['TIFF', 'Mamiya (RAW) Electronic Format'], 277 377 MIE => ['MIE', 'Meta Information Encapsulation format'], … … 282 382 MKV => ['MKV', 'Matroska Video'], 283 383 MNG => ['PNG', 'Multiple-image Network Graphics'], 284 # MODD => ['PLIST','Sony Picture Motion Metadata'], 384 MOBI => ['PDB', 'Mobipocket electronic book'], 385 MODD => ['PLIST','Sony Picture Motion metadata'], 386 MOI => ['MOI', 'MOD Information file'], 285 387 MOS => ['TIFF', 'Creo Leaf Mosaic'], 286 388 MOV => ['MOV', 'Apple QuickTime movie'], … … 293 395 MQV => ['MOV', 'Sony Mobile Quicktime Video'], 294 396 MRW => ['MRW', 'Minolta RAW format'], 295 MTS => ['M2TS', 'MPEG-2 Transport Stream'],397 MTS => 'M2TS', 296 398 MXF => ['MXF', 'Material Exchange Format'], 297 399 # NDPI => ['TIFF', 'Hamamatsu NanoZoomer Digital Pathology Image'], … … 301 403 NRW => ['TIFF', 'Nikon RAW (2)'], 302 404 NUMBERS => ['ZIP','Apple Numbers spreadsheet'], 405 O => ['EXE', 'Relocatable Object'], 406 ODB => ['ZIP', 'Open Document Database'], 407 ODC => ['ZIP', 'Open Document Chart'], 408 ODF => ['ZIP', 'Open Document Formula'], 409 ODG => ['ZIP', 'Open Document Graphics'], 410 ODI => ['ZIP', 'Open Document Image'], 303 411 ODP => ['ZIP', 'Open Document Presentation'], 304 412 ODS => ['ZIP', 'Open Document Spreadsheet'], 305 413 ODT => ['ZIP', 'Open Document Text file'], 414 OFR => ['RIFF', 'OptimFROG audio'], 306 415 OGG => ['OGG', 'Ogg Vorbis audio file'], 416 OGV => ['OGG', 'Ogg Video file'], 417 ONP => ['JSON', 'ON1 Presets'], 418 OPUS => ['OGG', 'Ogg Opus audio file'], 307 419 ORF => ['ORF', 'Olympus RAW format'], 308 420 OTF => ['Font', 'Open Type Font'], 421 PAC => ['RIFF', 'Lossless Predictive Audio Compression'], 309 422 PAGES => ['ZIP', 'Apple Pages document'], 310 423 PBM => ['PPM', 'Portable BitMap'], 424 PCD => ['PCD', 'Kodak Photo CD Image Pac'], 311 425 PCT => 'PICT', 426 PCX => ['PCX', 'PC Paintbrush'], 427 PDB => ['PDB', 'Palm Database'], 312 428 PDF => ['PDF', 'Adobe Portable Document Format'], 313 429 PEF => ['TIFF', 'Pentax (RAW) Electronic Format'], … … 317 433 PGF => ['PGF', 'Progressive Graphics File'], 318 434 PGM => ['PPM', 'Portable Gray Map'], 435 PHP => ['PHP', 'PHP Hypertext Preprocessor'], 436 PHP3 => 'PHP', 437 PHP4 => 'PHP', 438 PHP5 => 'PHP', 439 PHPS => 'PHP', 440 PHTML=> 'PHP', 319 441 PICT => ['PICT', 'Apple PICTure'], 320 #PLIST=> ['PLIST','Apple Property List'],442 PLIST=> ['PLIST','Apple Property List'], 321 443 PMP => ['PMP', 'Sony DSC-F1 Cyber-Shot PMP'], # should stand for Proprietery Metadata Package ;) 322 444 PNG => ['PNG', 'Portable Network Graphics'], … … 324 446 POTM => [['ZIP','FPX'], 'Office Open XML Presentation Template Macro-enabled'], 325 447 POTX => [['ZIP','FPX'], 'Office Open XML Presentation Template'], 448 PPAM => [['ZIP','FPX'], 'Office Open XML Presentation Addin Macro-enabled'], 449 PPAX => [['ZIP','FPX'], 'Office Open XML Presentation Addin'], 326 450 PPM => ['PPM', 'Portable Pixel Map'], 327 451 PPS => ['FPX', 'Microsoft PowerPoint Slideshow'], … … 331 455 PPTM => [['ZIP','FPX'], 'Office Open XML Presentation Macro-enabled'], 332 456 PPTX => [['ZIP','FPX'], 'Office Open XML Presentation'], 457 PRC => ['PDB', 'Palm Database'], 333 458 PS => ['PS', 'PostScript'], 334 459 PS2 => 'PS', 335 460 PS3 => 'PS', 336 461 PSB => ['PSD', 'Photoshop Large Document'], 337 PSD => ['PSD', 'Photoshop Drawing'], 462 PSD => ['PSD', 'Photoshop Document'], 463 PSDT => ['PSD', 'Photoshop Document Template'], 338 464 PSP => ['PSP', 'Paint Shop Pro'], 339 465 PSPFRAME => 'PSP', … … 342 468 PSPTUBE => 'PSP', 343 469 QIF => 'QTIF', 344 QT => ['MOV', 'QuickTime movie'],470 QT => 'MOV', 345 471 QTI => 'QTIF', 346 472 QTIF => ['QTIF', 'QuickTime Image File'], 473 R3D => ['R3D', 'Redcode RAW Video'], 347 474 RA => ['Real', 'Real Audio'], 348 475 RAF => ['RAF', 'FujiFilm RAW Format'], … … 361 488 RWL => ['TIFF', 'Leica RAW'], 362 489 RWZ => ['RWZ', 'Rawzor compressed image'], 490 SEQ => ['FLIR', 'FLIR image Sequence'], 491 SKETCH => ['ZIP', 'Sketch design file'], 363 492 SO => ['EXE', 'Shared Object file'], 364 493 SR2 => ['TIFF', 'Sony RAW Format 2'], … … 368 497 SWF => ['SWF', 'Shockwave Flash'], 369 498 TAR => ['TAR', 'TAR archive'], 370 THM => ['JPEG', ' CanonThumbnail'],499 THM => ['JPEG', 'Thumbnail'], 371 500 THMX => [['ZIP','FPX'], 'Office Open XML Theme'], 372 501 TIF => 'TIFF', 373 502 TIFF => ['TIFF', 'Tagged Image File Format'], 503 TORRENT => ['Torrent', 'BitTorrent description file'], 374 504 TS => 'M2TS', 375 505 TTC => ['Font', 'True Type Font Collection'], 376 506 TTF => ['Font', 'True Type Font'], 377 507 TUB => 'PSP', 508 TXT => ['TXT', 'Text file'], 509 VCARD=> ['VCard','Virtual Card'], 510 VCF => 'VCARD', 378 511 VOB => ['MPEG', 'Video Object'], 379 512 VRD => ['VRD', 'Canon VRD Recipe Data'], … … 384 517 WEBP => ['RIFF', 'Google Web Picture'], 385 518 WMA => ['ASF', 'Windows Media Audio'], 519 WMF => ['WMF', 'Windows Metafile Format'], 386 520 WMV => ['ASF', 'Windows Media Video'], 521 WV => ['RIFF', 'WavePack lossless audio'], 387 522 X3F => ['X3F', 'Sigma RAW format'], 523 MACOS=> ['MacOS','MacOS ._ sidecar file'], 388 524 XCF => ['XCF', 'GIMP native image format'], 389 525 XHTML=> ['HTML', 'Extensible HyperText Markup Language'], … … 398 534 XLTX => [['ZIP','FPX'], 'Office Open XML Spreadsheet Template'], 399 535 XMP => ['XMP', 'Extensible Metadata Platform'], 536 WOFF => ['Font', 'Web Open Font Format'], 537 WOFF2=> ['Font', 'Web Open Font Format2'], 538 WTV => ['WTV', 'Windows recorded TV show'], 400 539 ZIP => ['ZIP', 'ZIP archive'], 540 ); 541 542 # typical extension for each file type (if different than FileType) 543 # - case is not significant 544 my %fileTypeExt = ( 545 'Canon 1D RAW' => 'tif', 546 DICOM => 'dcm', 547 FLIR => 'fff', 548 GZIP => 'gz', 549 JPEG => 'jpg', 550 M2TS => 'mts', 551 MPEG => 'mpg', 552 TIFF => 'tif', 553 VCard => 'vcf', 401 554 ); 402 555 … … 404 557 my %fileDescription = ( 405 558 DICOM => 'Digital Imaging and Communications in Medicine', 406 PLIST => 'Property List',407 559 XML => 'Extensible Markup Language', 408 'DJVU (multi-page)' => 'DjVu multi-page image',409 560 'Win32 EXE' => 'Windows 32-bit Executable', 410 561 'Win32 DLL' => 'Windows 32-bit Dynamic Link Library', 562 'Win64 EXE' => 'Windows 64-bit Executable', 563 'Win64 DLL' => 'Windows 64-bit Dynamic Link Library', 411 564 ); 412 565 413 566 # MIME types for applicable file types above 414 # (missing entries default to 'application/unknown', but note that 415 # other mime types may be specified by some modules, ie. QuickTime.pm)567 # (missing entries default to 'application/unknown', but note that other MIME 568 # types may be specified by some modules, eg. QuickTime.pm and RIFF.pm) 416 569 %mimeType = ( 417 570 '3FR' => 'image/x-hasselblad-3fr', 571 AA => 'audio/audible', 572 AAE => 'application/vnd.apple.photos', 418 573 AI => 'application/vnd.adobe.illustrator', 419 574 AIFF => 'audio/x-aiff', 575 ALIAS=> 'application/x-macos', 420 576 APE => 'audio/x-monkeys-audio', 577 APNG => 'image/apng', 421 578 ASF => 'video/x-ms-asf', 422 579 ARW => 'image/x-sony-arw', 423 AVI => 'video/x-msvideo',424 580 BMP => 'image/bmp', 581 BPG => 'image/bpg', 425 582 BTF => 'image/x-tiff-big', #(NC) (ref http://www.asmail.be/msg0055371937.html) 426 583 BZ2 => 'application/bzip2', 427 584 'Canon 1D RAW' => 'image/x-raw', # (uses .TIF file extension) 585 CHM => 'application/x-chm', 586 COS => 'application/octet-stream', #PH (NC) 428 587 CR2 => 'image/x-canon-cr2', 588 CR3 => 'image/x-canon-cr3', 589 CRM => 'video/x-canon-crm', 429 590 CRW => 'image/x-canon-crw', 591 CSV => 'text/csv', 592 CZI => 'image/x-zeiss-czi', #PH (NC) 593 DCP => 'application/octet-stream', #PH (NC) 430 594 DCR => 'image/x-kodak-dcr', 595 DCX => 'image/dcx', 596 DEX => 'application/octet-stream', 431 597 DFONT=> 'application/x-dfont', 432 DIC M=> 'application/dicom',598 DICOM=> 'application/dicom', 433 599 DIVX => 'video/divx', 434 600 DJVU => 'image/vnd.djvu', … … 440 606 DOTM => 'application/vnd.ms-word.template.macroEnabledTemplate', 441 607 DOTX => 'application/vnd.openxmlformats-officedocument.wordprocessingml.template', 608 DPX => 'image/x-dpx', 609 DR4 => 'application/octet-stream', #PH (NC) 610 DS2 => 'audio/x-ds2', 611 DSS => 'audio/x-dss', 442 612 DV => 'video/x-dv', 613 'DVR-MS' => 'video/x-ms-dvr', 614 DWF => 'model/vnd.dwf', 615 DWG => 'image/vnd.dwg', 443 616 EIP => 'application/x-captureone', #(NC) 444 617 EPS => 'application/postscript', 445 618 ERF => 'image/x-epson-erf', 446 619 EXE => 'application/octet-stream', 620 EXR => 'image/x-exr', 621 EXV => 'image/x-exv', 622 FFF => 'image/x-hasselblad-fff', 623 FITS => 'image/fits', 447 624 FLA => 'application/vnd.adobe.fla', 448 625 FLAC => 'audio/flac', 626 FLIF => 'image/flif', 627 FLIR => 'image/x-flir-fff', #PH (NC) 449 628 FLV => 'video/x-flv', 450 629 Font => 'application/x-font-type1', # covers PFA, PFB and PFM (not sure about PFM) 630 FPF => 'image/x-flir-fpf', #PH (NC) 451 631 FPX => 'image/vnd.fpx', 452 632 GIF => 'image/gif', 633 GPR => 'image/x-gopro-gpr', 453 634 GZIP => 'application/x-gzip', 454 635 HDP => 'image/vnd.ms-photo', 636 HDR => 'image/vnd.radiance', 455 637 HTML => 'text/html', 456 638 ICC => 'application/vnd.iccprofile', 639 ICS => 'text/calendar', 640 IDML => 'application/vnd.adobe.indesign-idml-package', 457 641 IIQ => 'image/x-raw', 458 642 IND => 'application/x-indesign', 643 INX => 'application/x-indesign-interchange', #PH (NC) 644 ISO => 'application/x-iso9660-image', 459 645 ITC => 'application/itunes', 646 J2C => 'image/x-j2c', #PH (NC) 460 647 JNG => 'image/jng', 461 648 JP2 => 'image/jp2', … … 463 650 JPM => 'image/jpm', 464 651 JPX => 'image/jpx', 652 JSON => 'application/json', 653 JXR => 'image/jxr', 465 654 K25 => 'image/x-kodak-k25', 466 655 KDC => 'image/x-kodak-kdc', 656 KEY => 'application/x-iwork-keynote-sffkey', 657 LFP => 'image/x-lytro-lfp', #PH (NC) 467 658 LNK => 'application/octet-stream', 659 LRI => 'image/x-light-lri', 468 660 M2T => 'video/mpeg', 469 661 M2TS => 'video/m2ts', 662 MAX => 'application/x-3ds', 470 663 MEF => 'image/x-mamiya-mef', 471 664 MIE => 'application/x-mie', … … 475 668 MKV => 'video/x-matroska', 476 669 MNG => 'video/mng', 670 MOBI => 'application/x-mobipocket-ebook', 671 MOI => 'application/octet-stream', #PH (NC) 477 672 MOS => 'image/x-raw', 478 673 MOV => 'video/quicktime', … … 485 680 NEF => 'image/x-nikon-nef', 486 681 NRW => 'image/x-nikon-nrw', 682 NUMBERS => 'application/x-iwork-numbers-sffnumbers', 683 ODB => 'application/vnd.oasis.opendocument.database', 684 ODC => 'application/vnd.oasis.opendocument.chart', 685 ODF => 'application/vnd.oasis.opendocument.formula', 686 ODG => 'application/vnd.oasis.opendocument.graphics', 687 ODI => 'application/vnd.oasis.opendocument.image', 487 688 ODP => 'application/vnd.oasis.opendocument.presentation', 488 689 ODS => 'application/vnd.oasis.opendocument.spreadsheet', 489 690 ODT => 'application/vnd.oasis.opendocument.text', 490 OGG => 'audio/x-ogg', 691 OGG => 'audio/ogg', 692 OGV => 'video/ogg', 693 ONP => 'application/on1', 491 694 ORF => 'image/x-olympus-orf', 492 695 OTF => 'application/x-font-otf', 696 PAGES=> 'application/x-iwork-pages-sffpages', 493 697 PBM => 'image/x-portable-bitmap', 698 PCD => 'image/x-photo-cd', 699 PCX => 'image/pcx', 700 PDB => 'application/vnd.palm', 494 701 PDF => 'application/pdf', 495 702 PEF => 'image/x-pentax-pef', 703 PFA => 'application/x-font-type1', # (needed if handled by PostScript module) 496 704 PGF => 'image/pgf', 497 705 PGM => 'image/x-portable-graymap', 706 PHP => 'application/x-httpd-php', 498 707 PICT => 'image/pict', 499 PLIST=> 'application/xml', 708 PLIST=> 'application/xml', # (binary PLIST format is 'application/x-plist', recognized at run time) 709 PMP => 'image/x-sony-pmp', #PH (NC) 500 710 PNG => 'image/png', 501 711 POT => 'application/vnd.ms-powerpoint', 502 712 POTM => 'application/vnd.ms-powerpoint.template.macroEnabled', 503 713 POTX => 'application/vnd.openxmlformats-officedocument.presentationml.template', 714 PPAM => 'application/vnd.ms-powerpoint.addin.macroEnabled', 715 PPAX => 'application/vnd.openxmlformats-officedocument.presentationml.addin', # (NC, PH invented) 504 716 PPM => 'image/x-portable-pixmap', 505 717 PPS => 'application/vnd.ms-powerpoint', … … 513 725 PSP => 'image/x-paintshoppro', #(NC) 514 726 QTIF => 'image/x-quicktime', 727 R3D => 'video/x-red-r3d', #PH (invented) 515 728 RA => 'audio/x-pn-realaudio', 516 729 RAF => 'image/x-fujifilm-raf', … … 527 740 RWL => 'image/x-leica-rwl', 528 741 RWZ => 'image/x-rawzor', #(duplicated in Rawzor.pm) 742 SEQ => 'image/x-flir-seq', #PH (NC) 743 SKETCH => 'application/sketch', 529 744 SR2 => 'image/x-sony-sr2', 530 745 SRF => 'image/x-sony-srf', … … 535 750 THMX => 'application/vnd.ms-officetheme', 536 751 TIFF => 'image/tiff', 752 Torrent => 'application/x-bittorrent', 537 753 TTC => 'application/x-font-ttf', 538 754 TTF => 'application/x-font-ttf', 755 TXT => 'text/plain', 756 VCard=> 'text/vcard', 757 VRD => 'application/octet-stream', #PH (NC) 539 758 VSD => 'application/x-visio', 540 WAV => 'audio/x-wav',541 759 WDP => 'image/vnd.ms-photo', 542 760 WEBM => 'video/webm', 543 WEBP => 'image/webp',544 761 WMA => 'audio/x-ms-wma', 762 WMF => 'application/x-wmf', 545 763 WMV => 'video/x-ms-wmv', 764 WTV => 'video/x-ms-wtv', 546 765 X3F => 'image/x-sigma-x3f', 547 766 XCF => 'image/x-xcf', … … 565 784 # - module name '0' indicates a recognized but unsupported file 566 785 my %moduleName = ( 786 AA => 'Audible', 787 ALIAS=> 0, 788 AVC => 0, 567 789 BTF => 'BigTIFF', 568 790 BZ2 => 0, 569 791 CRW => 'CanonRaw', 570 DICM => 'DICOM',792 CHM => 'EXE', 571 793 COS => 'CaptureOne', 794 CZI => 'ZISRAW', 795 DEX => 0, 572 796 DOCX => 'OOXML', 797 DCX => 0, 798 DR4 => 'CanonVRD', 799 DSS => 'Olympus', 800 DWF => 0, 801 DWG => 0, 573 802 EPS => 'PostScript', 574 803 EXIF => '', 804 EXR => 'OpenEXR', 805 EXV => '', 575 806 ICC => 'ICC_Profile', 576 807 IND => 'InDesign', 577 808 FLV => 'Flash', 809 FPF => 'FLIR', 578 810 FPX => 'FlashPix', 579 811 GZIP => 'ZIP', 812 HDR => 'Radiance', 580 813 JP2 => 'Jpeg2000', 581 814 JPEG => '', 582 # MODD => 'XML', 815 LFP => 'Lytro', 816 LRI => 0, 583 817 MOV => 'QuickTime', 584 818 MKV => 'Matroska', 585 819 MP3 => 'ID3', 586 820 MRW => 'MinoltaRaw', 587 OGG => ' Vorbis',821 OGG => 'Ogg', 588 822 ORF => 'Olympus', 589 # PLIST=> 'XML', 823 PDB => 'Palm', 824 PCD => 'PhotoCD', 825 PHP => 0, 590 826 PMP => 'Sony', 591 827 PS => 'PostScript', 592 828 PSD => 'Photoshop', 593 829 QTIF => 'QuickTime', 830 R3D => 'Red', 594 831 RAF => 'FujiFilm', 595 832 RAR => 'ZIP', … … 599 836 TAR => 0, 600 837 TIFF => '', 838 TXT => 'Text', 601 839 VRD => 'CanonVRD', 840 WMF => 0, 602 841 X3F => 'SigmaRaw', 603 842 XCF => 'GIMP', 604 843 ); 605 844 845 $testLen = 1024; # number of bytes to read when testing for magic number 846 606 847 # quick "magic number" file test used to avoid loading module unnecessarily: 607 # - regular expression evaluated on first 1024bytes of file848 # - regular expression evaluated on first $testLen bytes of file 608 849 # - must match beginning at first byte in file 609 850 # - this test must not be more stringent than module logic 610 851 %magicNumber = ( 852 AA => '.{4}\x57\x90\x75\x36', 611 853 AIFF => '(FORM....AIF[FC]|AT&TFORM)', 854 ALIAS=> "book\0\0\0\0mark\0\0\0\0", 612 855 APE => '(MAC |APETAGEX|ID3)', 613 856 ASF => '\x30\x26\xb2\x75\x8e\x66\xcf\x11\xa6\xd9\x00\xaa\x00\x62\xce\x6c', 857 AVC => '\+A\+V\+C\+', 858 Torrent => 'd\d+:\w+', 614 859 BMP => 'BM', 860 BPG => "BPG\xfb", 615 861 BTF => '(II\x2b\0|MM\0\x2b)', 616 862 BZ2 => 'BZh[1-9]\x31\x41\x59\x26\x53\x59', 863 CHM => 'ITSF.{20}\x10\xfd\x01\x7c\xaa\x7b\xd0\x11\x9e\x0c\0\xa0\xc9\x22\xe6\xec', 617 864 CRW => '(II|MM).{4}HEAP(CCDR|JPGM)', 618 DICM => '(.{128}DICM|\0[\x02\x04\x06\x08]\0[\0-\x20]|[\x02\x04\x06\x08]\0[\0-\x20]\0)', 865 CZI => 'ZISRAWFILE\0{6}', 866 DCX => '\xb1\x68\xde\x3a', 867 DEX => "dex\n035\0", 868 DICOM=> '(.{128}DICM|\0[\x02\x04\x06\x08]\0[\0-\x20]|[\x02\x04\x06\x08]\0[\0-\x20]\0)', 619 869 DOCX => 'PK\x03\x04', 870 DPX => '(SDPX|XPDS)', 871 DR4 => 'IIII\x04\0\x04\0', 872 DSS => '(\x02dss|\x03ds2)', 620 873 DV => '\x1f\x07\0[\x3f\xbf]', # (not tested if extension recognized) 874 DWF => '\(DWF V\d', 875 DWG => 'AC10\d{2}\0', 621 876 EPS => '(%!PS|%!Ad|\xc5\xd0\xd3\xc6)', 622 877 EXE => '(MZ|\xca\xfe\xba\xbe|\xfe\xed\xfa[\xce\xcf]|[\xce\xcf]\xfa\xed\xfe|Joy!peff|\x7fELF|#!\s*/\S*bin/|!<arch>\x0a)', 623 878 EXIF => '(II\x2a\0|MM\0\x2a)', 879 EXR => '\x76\x2f\x31\x01', 880 EXV => '\xff\x01Exiv2', 881 FITS => 'SIMPLE = {20}T', 624 882 FLAC => '(fLaC|ID3)', 883 FLIF => 'FLIF[0-\x6f][0-2]', 884 FLIR => '[AF]FF\0', 625 885 FLV => 'FLV\x01', 626 886 Font => '((\0\x01\0\0|OTTO|true|typ1)[\0\x01]|ttcf\0[\x01\x02]\0\0|\0[\x01\x02]|' . 627 '(.{6})?%!(PS-(AdobeFont-|Bitstream )|FontType1-)|Start(Comp|Master)?FontMetrics)', 887 '(.{6})?%!(PS-(AdobeFont-|Bitstream )|FontType1-)|Start(Comp|Master)?FontMetrics|wOF[F2])', 888 FPF => 'FPF Public Image Format\0', 628 889 FPX => '\xd0\xcf\x11\xe0\xa1\xb1\x1a\xe1', 629 890 GIF => 'GIF8[79]a', 630 891 GZIP => '\x1f\x8b\x08', 631 HTML => '(?i)<(!DOCTYPE\s+HTML|HTML|\?xml)', # (case insensitive) 892 HDR => '#\?(RADIANCE|RGBE)\x0a', 893 HTML => '(\xef\xbb\xbf)?\s*(?i)<(!DOCTYPE\s+HTML|HTML|\?xml)', # (case insensitive) 632 894 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}', 633 895 IND => '\x06\x06\xed\xf5\xd8\x1d\x46\xe5\xbd\x31\xef\xe7\xfe\x74\xb7\x1d', 896 # ISO => signature is at byte 32768 634 897 ITC => '.{4}itch', 635 JP2 => ' \0\0\0\x0cjP( |\x1a\x1a)\x0d\x0a\x87\x0a',898 JP2 => '(\0\0\0\x0cjP( |\x1a\x1a)\x0d\x0a\x87\x0a|\xff\x4f\xff\x51\0)', 636 899 JPEG => '\xff\xd8\xff', 900 JSON => '(\xef\xbb\xbf)?\s*(\[\s*)?\{\s*"[^"]*"\s*:', 901 LFP => '\x89LFP\x0d\x0a\x1a\x0a', 637 902 LNK => '.{4}\x01\x14\x02\0{5}\xc0\0{6}\x46', 903 LRI => 'LELR \0', 638 904 M2TS => '(....)?\x47', 639 905 MIE => '~[\x10\x18]\x04.0MIE', 640 906 MIFF => 'id=ImageMagick', 641 907 MKV => '\x1a\x45\xdf\xa3', 642 MOV => '.{4}(free|skip|wide|ftyp|pnot|PICT|pict|moov|mdat|junk|uuid)', 908 MOV => '.{4}(free|skip|wide|ftyp|pnot|PICT|pict|moov|mdat|junk|uuid)', # (duplicated in WriteQuickTime.pl !!) 643 909 # MP3 => difficult to rule out 644 910 MPC => '(MP\+|ID3)', 911 MOI => 'V6', 645 912 MPEG => '\0\0\x01[\xb0-\xbf]', 646 913 MRW => '\0MR[MI]', … … 648 915 OGG => '(OggS|ID3)', 649 916 ORF => '(II|MM)', 650 PDF => '%PDF-\d+\.\d+', 917 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)', 918 # PCD => signature is at byte 2048 919 PCX => '\x0a[\0-\x05]\x01[\x01\x02\x04\x08].{64}[\0-\x02]', 920 PDF => '\s*%PDF-\d+\.\d+', 651 921 PGF => 'PGF', 922 PHP => '<\?php\s', 652 923 PICT => '(.{10}|.{522})(\x11\x01|\x00\x11)', 924 PLIST=> '(bplist0|\s*<|\xfe\xff\x00)', 653 925 PMP => '.{8}\0{3}\x7c.{112}\xff\xd8\xff\xdb', 654 926 PNG => '(\x89P|\x8aM|\x8bJ)NG\r\n\x1a\n', … … 658 930 PSP => 'Paint Shop Pro Image File\x0a\x1a\0{5}', 659 931 QTIF => '.{4}(idsc|idat|iicc)', 932 R3D => '\0\0..RED(1|2)', 660 933 RAF => 'FUJIFILM', 661 934 RAR => 'Rar!\x1a\x07\0', 662 935 RAW => '(.{25}ARECOYK|II|MM)', 663 936 Real => '(\.RMF|\.ra\xfd|pnm://|rtsp://|http://)', 664 RIFF => ' RIFF',937 RIFF => '(RIFF|LA0[234]|OFR |LPAC|wvpk|RF64)', # RIFF plus other variants 665 938 RSRC => '(....)?\0\0\x01\0', 666 939 RTF => '[\n\r]*\\{[\n\r]*\\\\rtf', 667 # (don't be too restrictive for RW2/RWL -- how does magic number change for big-endian?)668 RW2 => '(II|MM)', #(\x55\0\x18\0\0\0\x88\xe7\x74\xd8\xf8\x25\x1d\x4d\x94\x7a\x6e\x77\x82\x2b\x5d\x6a)669 RWL => '(II|MM)', #(ditto)670 940 RWZ => 'rawzor', 671 941 SWF => '[FC]WS[^\0]', 672 942 TAR => '.{257}ustar( )?\0', # (this doesn't catch old-style tar files) 943 TXT => '(\xff\xfe|(\0\0)?\xfe\xff|(\xef\xbb\xbf)?[\x07-\x0d\x20-\x7e\x80-\xfe]*$)', 673 944 TIFF => '(II|MM)', # don't test magic number (some raw formats are different) 945 VCard=> '(?i)BEGIN:(VCARD|VCALENDAR)\r\n', 674 946 VRD => 'CANON OPTIONAL DATA\0', 947 WMF => '(\xd7\xcd\xc6\x9a\0\0|\x01\0\x09\0\0\x03)', 948 WTV => '\xb7\xd8\x00\x20\x37\x49\xda\x11\xa6\x4e\x00\x07\xe9\x5e\xad\x8d', 675 949 X3F => 'FOVb', 950 MacOS=> '\0\x05\x16\x07\0.\0\0Mac OS X ', 676 951 XCF => 'gimp xcf ', 677 952 XMP => '\0{0,3}(\xfe\xff|\xff\xfe|\xef\xbb\xbf)?\0{0,3}\s*<', 678 953 ZIP => 'PK\x03\x04', 679 954 ); 955 956 # file types with weak magic number recognition 957 my %weakMagic = ( MP3 => 1 ); 958 959 # file types that are determined by the process proc when FastScan == 3 960 # (when done, the process proc must exit after SetFileType if FastScan is 3) 961 my %processType = map { $_ => 1 } qw(JPEG TIFF XMP AIFF EXE Font PS Real VCard TXT); 962 963 # Compact/XMPShorthand option settings 964 my %compactOpt = ( 965 nopadding => 'NoPadding', noindent => 'NoIndent', nonewline => 'NoNewline', 966 shorthand => 'Shorthand', onedesc => 'OneDesc', 967 all => ['NoPadding','NoIndent','NoNewline','Shorthand','OneDesc'], 968 allspace => ['NoPadding','NoIndent','NoNewline'], allformat => ['Shorthand','OneDesc'], 969 # aliases to cover anticipated user typos 970 nonewlines => 'NoNewline', nospace => 'NoIndent', nospaces => 'NoIndent', 971 nopad => 'NoPadding', onedescr => 'OneDesc', 972 # allow numerical settings for backward compatibility 973 0 => 'None', 974 1 => 'NoPadding', 975 2 => ['NoPadding','NoIndent'], 976 3 => ['NoPadding','NoIndent','OneDesc'], 977 4 => ['NoPadding','NoIndent','OneDesc','NoNewline'], 978 5 => ['NoPadding','NoIndent','OneDesc','NoNewline','Shorthand'], 979 ); 980 my %xmpShorthandOpt = ( 0 => 'None', 1 => 'Shorthand', 2 => ['Shorthand','OneDesc'] ); 680 981 681 982 # lookup for valid character set names (keys are all lower case) … … 694 995 vietnam => 'Vietnam', cp1258 => 'Vietnam', 695 996 thai => 'Thai', cp874 => 'Thai', 997 doslatinus => 'DOSLatinUS', cp437 => 'DOSLatinUS', 998 doslatin1 => 'DOSLatin1', cp850 => 'DOSLatin1', 999 doscyrillic => 'DOSCyrillic', cp866 => 'DOSCyrillic', 696 1000 macroman => 'MacRoman', cp10000 => 'MacRoman', mac => 'MacRoman', roman => 'MacRoman', 697 1001 maclatin2 => 'MacLatin2', cp10029 => 'MacLatin2', … … 704 1008 ); 705 1009 706 # default group priority for writing 707 my @defaultWriteGroups = qw(EXIF IPTC XMP MakerNotes Photoshop ICC_Profile CanonVRD); 1010 # default family 0 group priority for writing 1011 # (NOTE: tags in groups not specified here will not be written unless 1012 # overridden by the module or specified when writing) 1013 my @defaultWriteGroups = qw( 1014 EXIF IPTC XMP MakerNotes QuickTime Photoshop ICC_Profile CanonVRD Adobe 1015 ); 708 1016 709 1017 # group hash for ExifTool-generated tags … … 711 1019 712 1020 # special tag names (not used for tag info) 713 my %specialTags = ( 714 TABLE_NAME=>1, SHORT_NAME=>1, PROCESS_PROC=>1, WRITE_PROC=>1, CHECK_PROC=>1, 715 GROUPS=>1, FORMAT=>1, FIRST_ENTRY=>1, TAG_PREFIX=>1, PRINT_CONV=>1, 716 WRITABLE=>1, TABLE_DESC=>1, NOTES=>1, IS_OFFSET=>1, EXTRACT_UNKNOWN=>1, 717 NAMESPACE=>1, PREFERRED=>1, SRC_TABLE=>1, PRIORITY=>1, WRITE_GROUP=>1, 718 LANG_INFO=>1, VARS=>1, DATAMEMBER=>1, IS_SUBDIR=>1, SET_GROUP1=>1, 1021 %specialTags = map { $_ => 1 } qw( 1022 TABLE_NAME SHORT_NAME PROCESS_PROC WRITE_PROC CHECK_PROC 1023 GROUPS FORMAT FIRST_ENTRY TAG_PREFIX PRINT_CONV 1024 WRITABLE TABLE_DESC NOTES IS_OFFSET IS_SUBDIR 1025 EXTRACT_UNKNOWN NAMESPACE PREFERRED SRC_TABLE PRIORITY 1026 AVOID WRITE_GROUP LANG_INFO VARS DATAMEMBER 1027 SET_GROUP1 PERMANENT INIT_TABLE 719 1028 ); 720 1029 … … 734 1043 @Image::ExifTool::pluginTags = ( ); 735 1044 %Image::ExifTool::pluginTags = ( ); 1045 1046 my %systemTagsNotes = ( 1047 Notes => q{ 1048 extracted only if specifically requested or the L<SystemTags|../ExifTool.html#SystemTags> or L<RequestAll|../ExifTool.html#RequestAll> API 1049 option is set 1050 }, 1051 ); 736 1052 737 1053 # tag information for preview image -- this should be used for all … … 746 1062 RawConv => '$self->ValidateImage(ref $val ? $val : \$val, $tag)', 747 1063 # we allow preview image to be set to '', but we don't want a zero-length value 748 # in the IFD, so set it tem orarily to 'none'. Note that the length is <= 4,1064 # in the IFD, so set it temporarily to 'none'. Note that the length is <= 4, 749 1065 # so this value will fit in the IFD so the preview fixup won't be generated. 750 1066 ValueConvInv => '$val eq "" and $val="none"; $val', … … 758 1074 VARS => { NO_ID => 1 }, # tag ID's aren't meaningful for these tags 759 1075 WRITE_PROC => \&DummyWriteProc, 760 Error => { Priority => 0, Groups => \%allGroupsExifTool }, 761 Warning => { Priority => 0, Groups => \%allGroupsExifTool }, 1076 Error => { 1077 Priority => 0, 1078 Groups => \%allGroupsExifTool, 1079 Notes => q{ 1080 returns errors that may have occurred while reading or writing a file. Any 1081 Error will prevent the file from being processed. Minor errors may be 1082 downgraded to warnings with the -m or L<IgnoreMinorErrors|../ExifTool.html#IgnoreMinorErrors> option 1083 }, 1084 }, 1085 Warning => { 1086 Priority => 0, 1087 Groups => \%allGroupsExifTool, 1088 Notes => q{ 1089 returns warnings that may have occurred while reading or writing a file. 1090 Use the -a or L<Duplicates|../ExifTool.html#Duplicates> option to see all warnings if more than one 1091 occurred. Minor warnings may be ignored with the -m or L<IgnoreMinorErrors|../ExifTool.html#IgnoreMinorErrors> 1092 option. Minor warnings with a capital "M" in the "[Minor]" designation 1093 indicate that the processing is affected by ignoring the warning 1094 }, 1095 }, 762 1096 Comment => { 763 1097 Notes => 'comment embedded in JPEG, GIF89a or PPM/PGM/PBM image', … … 767 1101 }, 768 1102 Directory => { 769 Groups => { 1 => 'System' }, 1103 Groups => { 1 => 'System', 2 => 'Other' }, 1104 Notes => q{ 1105 the directory of the file as specified in the call to ExifTool, or "." if no 1106 directory was specified. May be written to move the file to another 1107 directory that will be created if doesn't already exist 1108 }, 770 1109 Writable => 1, 1110 WritePseudo => 1, 1111 DelCheck => q{"Can't delete"}, 771 1112 Protected => 1, 1113 RawConv => '$self->ConvertFileName($val)', 772 1114 # translate backslashes in directory names and add trailing '/' 773 ValueConvInv => '$_ =$val; tr/\\\\/\//; m{[^/]$} and $_ .= "/"; $_',1115 ValueConvInv => '$_ = $self->InverseFileName($val); m{[^/]$} and $_ .= "/"; $_', 774 1116 }, 775 1117 FileName => { 776 Groups => { 1 => 'System' },1118 Groups => { 1 => 'System', 2 => 'Other' }, 777 1119 Writable => 1, 1120 WritePseudo => 1, 1121 DelCheck => q{"Can't delete"}, 778 1122 Protected => 1, 779 1123 Notes => q{ 780 1124 may be written with a full path name to set FileName and Directory in one 781 operation. See L<filename.html|../filename.html> for more information on 782 writing the FileName and Directory tags 1125 operation. This is such a powerful feature that a TestName tag is provided 1126 to allow dry-run tests before actually writing the file name. See 1127 L<filename.html|../filename.html> for more information on writing the 1128 FileName, Directory and TestName tags 783 1129 }, 784 ValueConvInv => '$val=~tr/\\\\/\//; $val', 1130 RawConv => '$self->ConvertFileName($val)', 1131 ValueConvInv => '$self->InverseFileName($val)', 1132 }, 1133 FilePath => { 1134 Groups => { 1 => 'System', 2 => 'Other' }, 1135 Notes => q{ 1136 absolute path of source file. Not generated unless specifically requested or 1137 the L<RequestAll|../ExifTool.html#RequestAll> API option is set. Does not support Windows Unicode file 1138 names 1139 }, 1140 }, 1141 TestName => { 1142 Writable => 1, 1143 WritePseudo => 1, 1144 DelCheck => q{"Can't delete"}, 1145 Protected => 1, 1146 WriteOnly => 1, 1147 Notes => q{ 1148 this write-only tag may be used instead of FileName for dry-run tests of the 1149 file renaming feature. Writing this tag prints the old and new file names 1150 to the console, but does not affect the file itself 1151 }, 1152 ValueConvInv => '$self->InverseFileName($val)', 1153 }, 1154 FileSequence => { 1155 Groups => { 0 => 'ExifTool', 1 => 'ExifTool', 2 => 'Other' }, 1156 Notes => q{ 1157 sequence number for each source file when extracting or copying information, 1158 including files that fail the -if condition of the command-line application, 1159 beginning at 0 for the first file. Not generated unless specifically 1160 requested or the L<RequestAll|../ExifTool.html#RequestAll> API option is set 1161 }, 785 1162 }, 786 1163 FileSize => { 787 Groups => { 1 => 'System' }, 1164 Groups => { 1 => 'System', 2 => 'Other' }, 1165 Notes => q{ 1166 note that the print conversion for this tag uses historic prefixes: 1 kB = 1167 1024 bytes, etc. 1168 }, 788 1169 PrintConv => \&ConvertFileSize, 789 1170 }, 790 1171 ResourceForkSize => { 791 Groups => { 1 => 'System' },1172 Groups => { 1 => 'System', 2 => 'Other' }, 792 1173 Notes => q{ 793 [Mac OS only] size of the file's resource fork if it contains data. If this 794 tag is generated the ExtractEmbedded option may be used to extract 795 resource-fork information as a sub-document 1174 size of the file's resource fork if it contains data. Mac OS only. If this 1175 tag is generated the L<ExtractEmbedded|../ExifTool.html#ExtractEmbedded> option may be used to extract 1176 resource-fork information as a sub-document. When writing, the resource 1177 fork is preserved by default, but it may be deleted with C<-rsrc:all=> on 1178 the command line 796 1179 }, 797 1180 PrintConv => \&ConvertFileSize, 798 1181 }, 799 FileType => { }, 1182 FileType => { 1183 Groups => { 2 => 'Other' }, 1184 Notes => q{ 1185 a short description of the file type. For many file types this is the just 1186 the uppercase file extension 1187 }, 1188 }, 1189 FileTypeExtension => { 1190 Groups => { 2 => 'Other' }, 1191 Notes => q{ 1192 a common lowercase extension for this file type, or uppercase with the -n 1193 option 1194 }, 1195 PrintConv => 'lc $val', 1196 }, 800 1197 FileModifyDate => { 801 1198 Description => 'File Modification Date/Time', 802 Notes => 'the filesystem modification time', 1199 Notes => q{ 1200 the filesystem modification date/time. Note that ExifTool may not be able 1201 to handle filesystem dates before 1970 depending on the limitations of the 1202 system's standard libraries 1203 }, 803 1204 Groups => { 1 => 'System', 2 => 'Time' }, 804 1205 Writable => 1, 805 # all pseudo-tags must be protected so -tagsfromfile fails with 1206 WritePseudo => 1, 1207 DelCheck => q{"Can't delete"}, 1208 # all writable pseudo-tags must be protected so -tagsfromfile fails with 806 1209 # unrecognized files unless a pseudo tag is specified explicitly 807 1210 Protected => 1, … … 812 1215 PrintConvInv => '$self->InverseDateTime($val)', 813 1216 }, 1217 FileAccessDate => { 1218 Description => 'File Access Date/Time', 1219 Notes => q{ 1220 the date/time of last access of the file. Note that this access time is 1221 updated whenever any software, including ExifTool, reads the file 1222 }, 1223 Groups => { 1 => 'System', 2 => 'Time' }, 1224 ValueConv => 'ConvertUnixTime($val,1)', 1225 PrintConv => '$self->ConvertDateTime($val)', 1226 }, 1227 FileCreateDate => { 1228 Description => 'File Creation Date/Time', 1229 Notes => q{ 1230 the filesystem creation date/time. Windows/Mac only. In Windows, the file 1231 creation date/time is preserved by default when writing if Win32API::File 1232 and Win32::API are available. On Mac, this tag is extracted only if it or 1233 the MacOS group is specifically requested or the L<RequestAll|../ExifTool.html#RequestAll> API option is 1234 set to 2 or higher. Requires "setfile" for writing on Mac, which may be 1235 installed by typing C<xcode-select --install> in the Terminal 1236 }, 1237 Groups => { 1 => 'System', 2 => 'Time' }, 1238 Writable => 1, 1239 WritePseudo => 1, 1240 DelCheck => q{"Can't delete"}, 1241 Protected => 1, # all writable pseudo-tags must be protected! 1242 Shift => 'Time', 1243 ValueConv => '$^O eq "darwin" ? $val : ConvertUnixTime($val,1)', 1244 ValueConvInv => q{ 1245 return GetUnixTime($val,1) if $^O eq 'MSWin32'; 1246 return $val if $^O eq 'darwin'; 1247 warn "This tag is Windows/Mac only\n"; 1248 return undef; 1249 }, 1250 PrintConv => '$self->ConvertDateTime($val)', 1251 PrintConvInv => '$self->InverseDateTime($val)', 1252 }, 1253 FileInodeChangeDate => { 1254 Description => 'File Inode Change Date/Time', 1255 Notes => q{ 1256 the date/time when the file's directory information was last changed. 1257 Non-Windows systems only 1258 }, 1259 Groups => { 1 => 'System', 2 => 'Time' }, 1260 ValueConv => 'ConvertUnixTime($val,1)', 1261 PrintConv => '$self->ConvertDateTime($val)', 1262 }, 814 1263 FilePermissions => { 815 Groups => { 1 => 'System' },1264 Groups => { 1 => 'System', 2 => 'Other' }, 816 1265 Notes => q{ 817 1266 r=read, w=write and x=execute permissions for the file owner, group and 818 1267 others. The ValueConv value is an octal number so bit test operations on 819 this value should be done in octal, ie. "oct($filePermissions) & 0200"1268 this value should be done in octal, eg. 'oct($filePermissions#) & 0200' 820 1269 }, 821 ValueConv => 'sprintf("%.3o", $val & 0777)', 1270 Writable => 1, 1271 WritePseudo => 1, 1272 DelCheck => q{"Can't delete"}, 1273 Protected => 1, # all writable pseudo-tags must be protected! 1274 ValueConv => 'sprintf("%.3o", $val)', 1275 ValueConvInv => 'oct($val & 07777)', 822 1276 PrintConv => sub { 823 my ($mask, $str, $val) = (0400, '', oct(shift)); 1277 my ($mask, $val) = (0400, oct(shift)); 1278 my %types = ( 1279 0010000 => 'p', 1280 0020000 => 'c', 1281 0040000 => 'd', 1282 0060000 => 'b', 1283 0120000 => 'l', 1284 0140000 => 's', 1285 ); 1286 my $str = $types{$val & 0170000} || '-'; 824 1287 while ($mask) { 825 1288 foreach (qw(r w x)) { … … 830 1293 return $str; 831 1294 }, 1295 PrintConvInv => sub { 1296 my ($bit, $val, $str) = (8, 0, shift); 1297 $str = substr($str, 1) if length($str) == 10; 1298 return undef if length($str) != 9; 1299 while ($bit >= 0) { 1300 foreach (qw(r w x)) { 1301 $val |= (1 << $bit) if substr($str, 8-$bit, 1) eq $_; 1302 --$bit; 1303 } 1304 } 1305 return sprintf('%.3o', $val); 1306 }, 832 1307 }, 833 MIMEType => { }, 834 ImageWidth => { }, 835 ImageHeight => { }, 836 XResolution => { }, 837 YResolution => { }, 838 MaxVal => { }, # max pixel value in PPM or PGM image 1308 FileAttributes => { 1309 Groups => { 1 => 'System', 2 => 'Other' }, 1310 Notes => q{ 1311 extracted only if specifically requested or the L<SystemTags|../ExifTool.html#SystemTags> or L<RequestAll|../ExifTool.html#RequestAll> API 1312 option is set. 2 or 3 values: 0. File type, 1. Attribute bits, 2. Windows 1313 attribute bits if Win32API::File is available 1314 }, 1315 PrintHex => 1, 1316 PrintConvColumns => 2, 1317 PrintConv => [{ # stat device types (bitmask 0xf000) 1318 0x0000 => 'Unknown', 1319 0x1000 => 'FIFO', 1320 0x2000 => 'Character', 1321 0x3000 => 'Mux Character', 1322 0x4000 => 'Directory', 1323 0x5000 => 'XENIX Named', 1324 0x6000 => 'Block', 1325 0x7000 => 'Mux Block', 1326 0x8000 => 'Regular', 1327 0x9000 => 'VxFS Compressed', 1328 0xa000 => 'Symbolic Link', 1329 0xb000 => 'Solaris Shadow Inode', 1330 0xc000 => 'Socket', 1331 0xd000 => 'Solaris Door', 1332 0xe000 => 'BSD Whiteout', 1333 },{ BITMASK => { # stat attribute bits (bitmask 0x0e00) 1334 9 => 'Sticky', 1335 10 => 'Set Group ID', 1336 11 => 'Set User ID', 1337 }},{ BITMASK => { # Windows attribute bits 1338 0 => 'Read Only', 1339 1 => 'Hidden', 1340 2 => 'System', 1341 3 => 'Volume Label', 1342 4 => 'Directory', 1343 5 => 'Archive', 1344 6 => 'Device', 1345 7 => 'Normal', 1346 8 => 'Temporary', 1347 9 => 'Sparse File', 1348 10 => 'Reparse Point', 1349 11 => 'Compressed', 1350 12 => 'Offline', 1351 13 => 'Not Content Indexed', 1352 14 => 'Encrypted', 1353 }}], 1354 }, 1355 FileDeviceID => { 1356 Groups => { 1 => 'System', 2 => 'Other' }, 1357 %systemTagsNotes, 1358 PrintConv => '(($val >> 24) & 0xff) . "." . ($val & 0xffffff)', # (major.minor) 1359 }, 1360 FileDeviceNumber => { Groups => { 1 => 'System', 2 => 'Other' }, %systemTagsNotes }, 1361 FileInodeNumber => { Groups => { 1 => 'System', 2 => 'Other' }, %systemTagsNotes }, 1362 FileHardLinks => { Groups => { 1 => 'System', 2 => 'Other' }, %systemTagsNotes }, 1363 FileUserID => { 1364 Groups => { 1 => 'System', 2 => 'Other' }, 1365 Notes => q{ 1366 extracted only if specifically requested or the L<SystemTags|../ExifTool.html#SystemTags> or L<RequestAll|../ExifTool.html#RequestAll> API 1367 option is set. Returns user ID number with the -n option, or name 1368 otherwise. May be written with either user name or number 1369 }, 1370 Writable => 1, 1371 WritePseudo => 1, 1372 DelCheck => q{"Can't delete"}, 1373 Protected => 1, # all writable pseudo-tags must be protected! 1374 PrintConv => 'eval { getpwuid($val) } || $val', 1375 PrintConvInv => 'eval { getpwnam($val) } || ($val=~/[^0-9]/ ? undef : $val)', 1376 }, 1377 FileGroupID => { 1378 Groups => { 1 => 'System', 2 => 'Other' }, 1379 Notes => q{ 1380 extracted only if specifically requested or the L<SystemTags|../ExifTool.html#SystemTags> or L<RequestAll|../ExifTool.html#RequestAll> API 1381 option is set. Returns group ID number with the -n option, or name 1382 otherwise. May be written with either group name or number 1383 }, 1384 Writable => 1, 1385 WritePseudo => 1, 1386 DelCheck => q{"Can't delete"}, 1387 Protected => 1, # all writable pseudo-tags must be protected! 1388 PrintConv => 'eval { getgrgid($val) } || $val', 1389 PrintConvInv => 'eval { getgrnam($val) } || ($val=~/[^0-9]/ ? undef : $val)', 1390 }, 1391 FileBlockSize => { Groups => { 1 => 'System', 2 => 'Other' }, %systemTagsNotes }, 1392 FileBlockCount => { Groups => { 1 => 'System', 2 => 'Other' }, %systemTagsNotes }, 1393 HardLink => { 1394 Writable => 1, 1395 DelCheck => q{"Can't delete"}, 1396 WriteOnly => 1, 1397 WritePseudo => 1, 1398 Protected => 1, 1399 Notes => q{ 1400 this write-only tag is used to create a hard link with the specified name to 1401 the source file. If the source file is edited, copied, renamed or moved in 1402 the same operation as writing HardLink, then the link is made to the updated 1403 file. Note that subsequent editing of either hard-linked file by exiftool 1404 will break the link unless the -overwrite_original_in_place option is used 1405 }, 1406 ValueConvInv => '$val=~tr/\\\\/\//; $val', 1407 }, 1408 SymLink => { 1409 Writable => 1, 1410 DelCheck => q{"Can't delete"}, 1411 WriteOnly => 1, 1412 WritePseudo => 1, 1413 Protected => 1, 1414 Notes => q{ 1415 this write-only tag is used to create a symbolic link with the specified 1416 name to the source file. If the source file is edited, copied, renamed or 1417 moved in the same operation as writing SymLink, then the link is made to the 1418 updated file. The link uses an absolute path unless it is created in the 1419 current working directory. Valid only for file systems that support 1420 symbolic links. Note that subsequent editing of the file via the symbolic 1421 link by exiftool will cause the link to be replaced by the edited file 1422 without changing the original unless the -overwrite_original_in_place option 1423 is used 1424 }, 1425 ValueConvInv => '$val=~tr/\\\\/\//; $val', 1426 }, 1427 MIMEType => { Notes => 'the MIME type of the source file', Groups => { 2 => 'Other' } }, 1428 ImageWidth => { Notes => 'the width of the image in number of pixels' }, 1429 ImageHeight => { Notes => 'the height of the image in number of pixels' }, 1430 XResolution => { Notes => 'the horizontal pixel resolution' }, 1431 YResolution => { Notes => 'the vertical pixel resolution' }, 1432 MaxVal => { Notes => 'maximum pixel value in PPM or PGM image' }, 839 1433 EXIF => { 840 Notes => 'the full EXIF data block from JPEG, PNG, JP2, MIE and MIFF images', 1434 Notes => q{ 1435 the full EXIF data block from JPEG, PNG, JP2, MIE and MIFF images. This tag 1436 is generated only if specifically requested 1437 }, 841 1438 Groups => { 0 => 'EXIF', 1 => 'EXIF' }, 842 Flags => ['Writable' ,'Protected', 'Binary' ],1439 Flags => ['Writable' ,'Protected', 'Binary', 'DelGroup'], 843 1440 WriteCheck => q{ 844 1441 return undef if $val =~ /^(II\x2a\0|MM\0\x2a)/; … … 846 1443 }, 847 1444 }, 848 ICC_Profile => { 849 Notes => 'the full ICC_Profile data block', 850 Groups => { 0 => 'ICC_Profile', 1 => 'ICC_Profile' }, 851 Flags => ['Writable' ,'Protected', 'Binary'], 1445 IPTC => { 1446 Notes => q{ 1447 the full IPTC data block. This tag is generated only if specifically 1448 requested 1449 }, 1450 Groups => { 0 => 'IPTC', 1 => 'IPTC' }, 1451 Flags => ['Writable', 'Protected', 'Binary', 'DelGroup'], 1452 Priority => 0, # so main IPTC (which hopefully comes first) takes priority 852 1453 WriteCheck => q{ 853 re quire Image::ExifTool::ICC_Profile;854 return Image::ExifTool::ICC_Profile::ValidateICC(\$val);1454 return undef if $val =~ /^(\x1c|\0+$)/; 1455 return 'Invalid IPTC data'; 855 1456 }, 856 1457 }, 857 1458 XMP => { 858 Notes => 'the full XMP data block', 1459 Notes => q{ 1460 the XMP data block, but note that extended XMP in JPEG images may be split 1461 into multiple blocks. This tag is generated only if specifically requested 1462 }, 859 1463 Groups => { 0 => 'XMP', 1 => 'XMP' }, 860 Flags => ['Writable', 'Protected', 'Binary' ],1464 Flags => ['Writable', 'Protected', 'Binary', 'DelGroup'], 861 1465 Priority => 0, # so main xmp (which usually comes first) takes priority 862 1466 WriteCheck => q{ … … 865 1469 }, 866 1470 }, 1471 XML => { 1472 Notes => 'the XML data block, extracted for some file types', 1473 Groups => { 0 => 'XML', 1 => 'XML' }, 1474 Binary => 1, 1475 }, 1476 ICC_Profile => { 1477 Notes => q{ 1478 the full ICC_Profile data block. This tag is generated only if specifically 1479 requested 1480 }, 1481 Groups => { 0 => 'ICC_Profile', 1 => 'ICC_Profile' }, 1482 Flags => ['Writable' ,'Protected', 'Binary', 'DelGroup'], 1483 WriteCheck => q{ 1484 require Image::ExifTool::ICC_Profile; 1485 return Image::ExifTool::ICC_Profile::ValidateICC(\$val); 1486 }, 1487 }, 867 1488 CanonVRD => { 868 Notes => 'the full Canon DPP VRD trailer block', 1489 Notes => q{ 1490 the full Canon DPP VRD trailer block. This tag is generated only if 1491 specifically requested 1492 }, 869 1493 Groups => { 0 => 'CanonVRD', 1 => 'CanonVRD' }, 870 Flags => ['Writable' ,'Protected', 'Binary' ],1494 Flags => ['Writable' ,'Protected', 'Binary', 'DelGroup'], 871 1495 Permanent => 0, # (this is 1 by default for MakerNotes tags) 872 1496 WriteCheck => q{ … … 874 1498 return 'Invalid CanonVRD data'; 875 1499 }, 1500 }, 1501 CanonDR4 => { 1502 Notes => q{ 1503 the full Canon DPP version 4 DR4 block. This tag is generated only if 1504 specifically requested 1505 }, 1506 Groups => { 0 => 'CanonVRD', 1 => 'CanonVRD' }, 1507 Flags => ['Writable' ,'Protected', 'Binary'], 1508 Permanent => 0, # (this is 1 by default for MakerNotes tags) 1509 WriteCheck => q{ 1510 return undef if $val =~ /^IIII\x04\0\x04\0/; 1511 return 'Invalid CanonDR4 data'; 1512 }, 1513 }, 1514 Adobe => { 1515 Notes => q{ 1516 the JPEG APP14 Adobe segment. Extracted only if specified. See the 1517 L<JPEG Adobe Tags|JPEG.html#Adobe> for more information 1518 }, 1519 Groups => { 0 => 'APP14', 1 => 'Adobe' }, 1520 WriteGroup => 'Adobe', 1521 Flags => ['Writable' ,'Protected', 'Binary'], 876 1522 }, 877 1523 CurrentIPTCDigest => { … … 881 1527 specified by the L<MWG|http://www.metadataworkinggroup.org/>. ExifTool 882 1528 automates the handling of this tag in the MWG module -- see the 883 L<MWG Tag Name documentation|MWG.html> for details1529 L<MWG Composite Tags|MWG.html> for details 884 1530 }, 885 1531 ValueConv => 'unpack("H*", $val)', 886 1532 }, 887 1533 PreviewImage => { 1534 Notes => 'JPEG-format embedded preview image', 1535 Groups => { 2 => 'Preview' }, 888 1536 Writable => 1, 889 1537 WriteCheck => '$self->CheckImage(\$val)', 1538 WriteGroup => 'All', 890 1539 # can't delete, so set to empty string and return no error 891 1540 DelCheck => '$val = ""; return undef', … … 893 1542 RawConv => '$self->ValidateImage(ref $val ? $val : \$val, $tag)', 894 1543 }, 895 PreviewPNG => { Binary => 1 }, 1544 ThumbnailImage => { 1545 Groups => { 2 => 'Preview' }, 1546 Notes => 'JPEG-format embedded thumbnail image', 1547 RawConv => '$self->ValidateImage(ref $val ? $val : \$val, $tag)', 1548 }, 1549 OtherImage => { 1550 Groups => { 2 => 'Preview' }, 1551 Notes => 'other JPEG-format embedded image', 1552 RawConv => '$self->ValidateImage(ref $val ? $val : \$val, $tag)', 1553 }, 1554 PreviewPNG => { 1555 Groups => { 2 => 'Preview' }, 1556 Notes => 'PNG-format embedded preview image', 1557 Binary => 1, 1558 }, 1559 PreviewWMF => { 1560 Groups => { 2 => 'Preview' }, 1561 Notes => 'WMF-format embedded preview image', 1562 Binary => 1, 1563 }, 1564 PreviewTIFF => { 1565 Groups => { 2 => 'Preview' }, 1566 Notes => 'TIFF-format embedded preview image', 1567 Binary => 1, 1568 }, 1569 PreviewPDF => { 1570 Groups => { 2 => 'Preview' }, 1571 Notes => 'PDF-format embedded preview image', 1572 Binary => 1, 1573 }, 896 1574 ExifByteOrder => { 897 1575 Writable => 1, 898 Notes => 'only writable for newly created EXIF segments', 1576 DelCheck => q{"Can't delete"}, 1577 Notes => q{ 1578 represents the byte order of EXIF information. May be written to set the 1579 byte order only for newly created EXIF segments 1580 }, 899 1581 PrintConv => { 900 1582 II => 'Little-endian (Intel, II)', … … 904 1586 ExifUnicodeByteOrder => { 905 1587 Writable => 1, 1588 WriteOnly => 1, 1589 DelCheck => q{"Can't delete"}, 906 1590 Notes => q{ 907 the EXIF specification is particularly vague about the byte ordering for 908 Unicode text, and different applications use different conventions. By 909 default ExifTool writes Unicode text in EXIF byte order, but this write-only 910 tag may be used to force a specific byte order 1591 specifies the byte order to use when writing EXIF Unicode text. The EXIF 1592 specification is particularly vague about this byte ordering, and different 1593 applications use different conventions. By default ExifTool writes Unicode 1594 text in EXIF byte order, but this write-only tag may be used to force a 1595 specific order. Applies to the EXIF UserComment tag when writing special 1596 characters 911 1597 }, 912 1598 PrintConv => { … … 918 1604 Description => 'ExifTool Version Number', 919 1605 Groups => \%allGroupsExifTool, 1606 Notes => 'the version of ExifTool currently running', 920 1607 }, 921 RAFVersion => { }, 1608 ProcessingTime => { 1609 Groups => { 0 => 'ExifTool', 1 => 'ExifTool', 2 => 'Other' }, 1610 Notes => q{ 1611 the clock time in seconds taken by ExifTool to extract information from this 1612 file. Not generated unless specifically requested or the L<RequestAll|../ExifTool.html#RequestAll> API 1613 option is set. Requires Time::HiRes 1614 }, 1615 PrintConv => 'sprintf("%.3g s", $val)', 1616 }, 1617 RAFVersion => { Notes => 'RAF file version number' }, 922 1618 JPEGDigest => { 923 1619 Notes => q{ … … 926 1622 compared to known values in an attempt to deduce the originating software 927 1623 based only on the JPEG image data. For performance reasons, this tag is 928 generated only if specifically requested 1624 generated only if specifically requested or the L<RequestAll|../ExifTool.html#RequestAll> API option is set 1625 to 3 or higher 929 1626 }, 930 1627 }, 1628 JPEGQualityEstimate => { 1629 Notes => q{ 1630 an estimate of the IJG JPEG quality setting for the image, calculated from 1631 the quantization tables. For performance reasons, this tag is generated 1632 only if specifically requested or the L<RequestAll|../ExifTool.html#RequestAll> API option is set to 3 or 1633 higher 1634 }, 1635 }, 1636 JPEGImageLength => { 1637 Notes => q{ 1638 byte length of JPEG image without metadata. For performance reasons, this 1639 tag is generated only if specifically requested or the L<RequestAll|../ExifTool.html#RequestAll> API option 1640 is set to 3 or higher 1641 }, 1642 }, 1643 # Validate (added from Validate.pm) 931 1644 Now => { 932 1645 Groups => { 0 => 'ExifTool', 1 => 'ExifTool', 2 => 'Time' }, 933 1646 Notes => q{ 934 the current date/time. Useful when setting the tag values, ie. 935 C<"-modifydate<now">. Not generated unless specifically requested 936 }, 937 ValueConv => sub { 938 my $time = shift; 939 my @tm = localtime $time; 940 my $tz = Image::ExifTool::TimeZoneString(\@tm, $time); 941 sprintf("%4d:%.2d:%.2d %.2d:%.2d:%.2d%s", $tm[5]+1900, $tm[4]+1, $tm[3], 942 $tm[2], $tm[1], $tm[0], $tz); 1647 the current date/time. Useful when setting the tag values, eg. 1648 C<"-modifydate<now">. Not generated unless specifically requested or the 1649 L<RequestAll|../ExifTool.html#RequestAll> API option is set 943 1650 }, 944 1651 PrintConv => '$self->ConvertDateTime($val)', 945 1652 }, 946 ID3Size => { }, 1653 NewGUID => { 1654 Groups => { 0 => 'ExifTool', 1 => 'ExifTool', 2 => 'Other' }, 1655 Notes => q{ 1656 generates a new, random GUID with format 1657 YYYYmmdd-HHMM-SSNN-PPPP-RRRRRRRRRRRR, where Y=year, m=month, d=day, H=hour, 1658 M=minute, S=second, N=file sequence number in hex, P=process ID in hex, and 1659 R=random hex number; without dashes with the -n option. Not generated 1660 unless specifically requested or the L<RequestAll|../ExifTool.html#RequestAll> API option is set 1661 }, 1662 PrintConv => '$val =~ s/(.{8})(.{4})(.{4})(.{4})/$1-$2-$3-$4-/; $val', 1663 }, 1664 ID3Size => { Notes => 'size of the ID3 data block' }, 947 1665 Geotag => { 948 1666 Writable => 1, 1667 WriteOnly => 1, 1668 WriteNothing => 1, 949 1669 AllowGroup => '(exif|gps|xmp|xmp-exif)', 950 1670 Notes => q{ 951 1671 this write-only tag is used to define the GPS track log data or track log 952 1672 file name. Currently supported track log formats are GPX, NMEA RMC/GGA/GLL, 953 KML, IGC, Garmin XML and TCX, and Magellan PMGNTRK. See 954 L<geotag.html|../geotag.html> for details 1673 KML, IGC, Garmin XML and TCX, Magellan PMGNTRK, Honeywell PTNTHPR, Winplus 1674 Beacon text, and Bramor gEO log files. May be set to the special value of 1675 "DATETIMEONLY" (all caps) to set GPS date/time tags if no input track points 1676 are available. See L<geotag.html|../geotag.html> for details 955 1677 }, 956 1678 DelCheck => q{ … … 970 1692 Geotime => { 971 1693 Writable => 1, 1694 WriteOnly => 1, 972 1695 AllowGroup => '(exif|gps|xmp|xmp-exif)', 973 1696 Notes => q{ 974 1697 this write-only tag is used to define a date/time for interpolating a 975 1698 position in the GPS track specified by the Geotag tag. Writing this tag 976 causes the following 8 tags to be written: GPSLatitude, GPSLatitudeRef, 977 GPSLongitude, GPSLongitudeRef, GPSAltitude, GPSAltitudeRef, GPSDateStamp and 978 GPSTimeStamp. The local system timezone is assumed if the date/time value 979 does not contain a timezone. May be deleted to delete associated GPS tags. 980 A group name of 'EXIF' or 'XMP' may be specified to write or delete only 981 EXIF or XMP GPS tags. The value of Geotag must be assigned before this tag 1699 causes GPS information to be written into the EXIF or XMP of the target 1700 files. The local system timezone is assumed if the date/time value does not 1701 contain a timezone. May be deleted to delete associated GPS tags. A group 1702 name of "EXIF" or "XMP" may be specified to write or delete only EXIF or XMP 1703 GPS tags 982 1704 }, 983 1705 DelCheck => q{ … … 994 1716 Geosync => { 995 1717 Writable => 1, 1718 WriteOnly => 1, 1719 WriteNothing => 1, 996 1720 AllowGroup => '(exif|gps|xmp|xmp-exif)', 997 1721 Shift => 'Time', # enables "+=" syntax as well as "=+" … … 1000 1724 synchronization with the GPS clock. For example, set this to "-12" if the 1001 1725 camera clock is 12 seconds faster than GPS time. Input format is 1002 "[+-][[[DD ]HH:]MM:]SS[.ss]". Must be set before Geotime to be effective. 1003 Additional features allow calculation of time differences and time drifts, 1004 and extraction of synchronization times from image files. See the 1005 L<geotagging documentation|../geotag.html> for details 1726 "[+-][[[DD ]HH:]MM:]SS[.ss]". Additional features allow calculation of time 1727 differences and time drifts, and extraction of synchronization times from 1728 image files. See the L<geotagging documentation|../geotag.html> for details 1006 1729 }, 1007 1730 ValueConvInv => q{ … … 1010 1733 }, 1011 1734 }, 1735 ForceWrite => { 1736 Groups => { 0 => '*', 1 => '*', 2 => '*' }, 1737 Writable => 1, 1738 WriteOnly => 1, 1739 Notes => q{ 1740 write-only tag used to force metadata in a file to be rewritten even if no 1741 tag values are changed. May be set to "EXIF", "IPTC", "XMP" or "PNG" to 1742 force the corresponding metadata type to be rewritten, "FixBase" to cause 1743 EXIF to be rewritten only if the MakerNotes offset base was fixed, or "All" 1744 to rewrite all of these metadata types. Values are case insensitive, and 1745 multiple values may be separated with commas, eg. C<-ForceWrite=exif,xmp> 1746 }, 1747 }, 1748 EmbeddedVideo => { Groups => { 0 => 'Trailer', 2 => 'Video' } }, 1749 Trailer => { 1750 Groups => { 0 => 'Trailer' }, 1751 Notes => 'the full JPEG trailer data block. Extracted only if specifically requested', 1752 Writable => 1, 1753 Protected => 1, 1754 }, 1755 ); 1756 1757 # tags defined by UserParam option (added at runtime) 1758 %Image::ExifTool::UserParam = ( 1759 GROUPS => { 0 => 'UserParam', 1 => 'UserParam', 2 => 'Other' }, 1760 PRIORITY => 0, 1012 1761 ); 1013 1762 … … 1071 1820 Format => 'int8u[2]', 1072 1821 PrintConv => 'sprintf("%d.%.2d", split(" ",$val))', 1822 Mandatory => 1, 1073 1823 }, 1074 1824 2 => { … … 1082 1832 }, 1083 1833 Priority => -1, 1834 Mandatory => 1, 1084 1835 }, 1085 1836 3 => { … … 1089 1840 Priority => -1, 1090 1841 RawConv => '$$self{JFIFXResolution} = $val', 1842 Mandatory => 1, 1091 1843 }, 1092 1844 5 => { … … 1096 1848 Priority => -1, 1097 1849 RawConv => '$$self{JFIFYResolution} = $val', 1850 Mandatory => 1, 1851 }, 1852 7 => { 1853 Name => 'ThumbnailWidth', 1854 RawConv => '$val ? $$self{JFIFThumbnailWidth} = $val : undef', 1855 }, 1856 8 => { 1857 Name => 'ThumbnailHeight', 1858 RawConv => '$val ? $$self{JFIFThumbnailHeight} = $val : undef', 1859 }, 1860 9 => { 1861 Name => 'ThumbnailTIFF', 1862 Groups => { 2 => 'Preview' }, 1863 Format => 'undef[3*($val{7}||0)*($val{8}||0)]', 1864 Notes => 'raw RGB thumbnail data, extracted as a TIFF image', 1865 RawConv => 'length($val) ? $val : undef', 1866 ValueConv => sub { 1867 my ($val, $et) = @_; 1868 my $len = length $val; 1869 return \ "Binary data $len bytes" unless $et->Options('Binary'); 1870 my $img = MakeTiffHeader($$et{JFIFThumbnailWidth},$$et{JFIFThumbnailHeight},3,8) . $val; 1871 return \$img; 1872 }, 1098 1873 }, 1099 1874 ); 1100 1875 %Image::ExifTool::JFIF::Extension = ( 1101 GROUPS => { 0 => 'JFIF', 1 => 'JFIF', 2 => 'Image' }, 1876 GROUPS => { 0 => 'JFIF', 1 => 'JFXX', 2 => 'Image' }, 1877 NOTES => 'Thumbnail images extracted from the JFXX segment.', 1102 1878 0x10 => { 1103 1879 Name => 'ThumbnailImage', 1880 Groups => { 2 => 'Preview' }, 1881 Notes => 'JPEG-format thumbnail image', 1104 1882 RawConv => '$self->ValidateImage(\$val,$tag)', 1883 }, 1884 0x11 => { # (untested) 1885 Name => 'ThumbnailTIFF', 1886 Groups => { 2 => 'Preview' }, 1887 Notes => 'raw palette-color thumbnail data, extracted as a TIFF image', 1888 RawConv => '(length $val > 770 and $val !~ /^\0\0/) ? $val : undef', 1889 ValueConv => sub { 1890 my ($val, $et) = @_; 1891 my $len = length $val; 1892 return \ "Binary data $len bytes" unless $et->Options('Binary'); 1893 my ($w, $h) = unpack('CC', $val); 1894 my $img = MakeTiffHeader($w,$h,1,8,undef,substr($val,2,768)) . substr($val,770); 1895 return \$img; 1896 }, 1897 }, 1898 0x13 => { 1899 Name => 'ThumbnailTIFF', 1900 Groups => { 2 => 'Preview' }, 1901 Notes => 'raw RGB thumbnail data, extracted as a TIFF image', 1902 RawConv => '(length $val > 2 and $val !~ /^\0\0/) ? $val : undef', 1903 ValueConv => sub { 1904 my ($val, $et) = @_; 1905 my $len = length $val; 1906 return \ "Binary data $len bytes" unless $et->Options('Binary'); 1907 my ($w, $h) = unpack('CC', $val); 1908 my $img = MakeTiffHeader($w,$h,3,8) . substr($val,2); 1909 return \$img; 1910 }, 1105 1911 }, 1106 1912 ); … … 1115 1921 ); 1116 1922 1923 my %compositeID; # lookup for new ID's of Composite tags based on original ID 1924 1117 1925 # static private ExifTool variables 1118 1926 … … 1131 1939 1132 1940 # Clean unnecessary information (line number, LF) from warning 1133 # Inputs: 0) warning string or undef to use current warning1941 # Inputs: 0) warning string or undef to use $evalWarning 1134 1942 # Returns: cleaned warning 1135 1943 sub CleanWarning(;$) … … 1160 1968 1161 1969 $self->ClearOptions(); # create default options hash 1162 $self->{VALUE} = { }; # must initialize this for warning messages 1163 $self->{DEL_GROUP} = { }; # lookup for groups to delete when writing 1970 $$self{VALUE} = { }; # must initialize this for warning messages 1971 $$self{PATH} = [ ]; # (this too) 1972 $$self{DEL_GROUP} = { }; # lookup for groups to delete when writing 1973 $$self{SAVE_COUNT} = 0; # count calls to SaveNewValues() 1974 $$self{FILE_SEQUENCE} = 0; # sequence number for files when reading 1164 1975 1165 1976 # initialize our new groups for writing … … 1187 1998 # my $info = ImageInfo($file, 'DateTimeOriginal', 'ImageSize'); 1188 1999 # - or - 1189 # my $e xifTool= new Image::ExifTool;1190 # my $info = $e xifTool->ImageInfo($file, \@tagList, {Sort=>'Group0'} );2000 # my $et = new Image::ExifTool; 2001 # my $info = $et->ImageInfo($file, \@tagList, {Sort=>'Group0'} ); 1191 2002 sub ImageInfo($;@) 1192 2003 { … … 1199 2010 $self = new Image::ExifTool; 1200 2011 } 1201 my %saveOptions = %{$ self->{OPTIONS}};# save original options2012 my %saveOptions = %{$$self{OPTIONS}}; # save original options 1202 2013 1203 2014 # initialize file information 1204 $ self->{FILENAME} = $self->{RAF} = undef;2015 $$self{FILENAME} = $$self{RAF} = undef; 1205 2016 1206 2017 $self->ParseArguments(@_); # parse our function arguments … … 1208 2019 my $info = $self->GetInfo(undef); # get requested information 1209 2020 1210 $ self->{OPTIONS} = \%saveOptions;# restore original options2021 $$self{OPTIONS} = \%saveOptions; # restore original options 1211 2022 1212 2023 return $info; # return requested information … … 1216 2027 # Get/set ExifTool options 1217 2028 # Inputs: 0) ExifTool object reference, 1218 # 1) Parameter name , 2) Value to set the option2029 # 1) Parameter name (case insensitive), 2) Value to set the option 1219 2030 # 3-N) More parameter/value pairs 1220 2031 # Returns: original value of last option specified … … 1228 2039 while (@_) { 1229 2040 my $param = shift; 2041 # fix parameter case if necessary 2042 unless (exists $$options{$param}) { 2043 my ($fixed) = grep /^$param$/i, keys %$options; 2044 if ($fixed) { 2045 $param = $fixed; 2046 } else { 2047 $param =~ s/^Group(\d*)$/Group$1/i; 2048 } 2049 } 1230 2050 $oldVal = $$options{$param}; 2051 if (ref $oldVal eq 'HASH' and ($param eq 'Compact' or $param eq 'XMPShorthand')) { 2052 # get previous Compact/XMPShorthand setting 2053 $oldVal = $$oldVal{$param}; 2054 } 1231 2055 last unless @_; 1232 2056 my $newVal = shift; … … 1267 2091 warn "Invalid Charset $newVal\n"; 1268 2092 } 1269 } 2093 } elsif ($param eq 'CharsetEXIF' or $param eq 'CharsetFileName' or $param eq 'CharsetRIFF') { 2094 $$options{$param} = $newVal; # only these may be set to a false value 2095 } elsif ($param eq 'CharsetQuickTime') { 2096 $$options{$param} = 'MacRoman'; # QuickTime defaults to MacRoman 2097 } else { 2098 $$options{$param} = 'Latin'; # all others default to Latin 2099 } 2100 } elsif ($param eq 'UserParam') { 2101 # clear options if $newVal is undef 2102 defined $newVal or $$options{$param} = {}, next; 2103 my $table = GetTagTable('Image::ExifTool::UserParam'); 2104 # allow initialization of entire UserParam hash 2105 if (ref $newVal eq 'HASH') { 2106 my %newParams; 2107 foreach (sort keys %$newVal) { 2108 my $lcTag = lc $_; 2109 $newParams{$lcTag} = $$newVal{$_}; 2110 delete $$table{$lcTag}; 2111 AddTagToTable($table, $lcTag, $_); 2112 } 2113 $$options{$param} = \%newParams; 2114 next; 2115 } 2116 my ($force, $paramName); 2117 # set/reset single UserParam parameter 2118 if ($newVal =~ /(.*?)=(.*)/s) { 2119 $paramName = $1; 2120 $newVal = $2; 2121 $force = 1 if $paramName =~ s/\^$//; 2122 $paramName =~ tr/-_a-zA-Z0-9#//dc; 2123 $param = lc $paramName; 2124 } else { 2125 ($param = lc $newVal) =~ tr/-_a-zA-Z0-9#//dc; 2126 undef $newVal; 2127 } 2128 delete $$table{$param}; 2129 $oldVal = $$options{UserParam}{$param}; 2130 if (defined $newVal) { 2131 if (length $newVal or $force) { 2132 $$options{UserParam}{$param} = $newVal; 2133 AddTagToTable($table, $param, $paramName); 2134 } else { 2135 delete $$options{UserParam}{$param}; 2136 } 2137 } 2138 # remove alternate version of tag 2139 $param .= '#' unless $param =~ s/#$//; 2140 delete $$table{$param}; 2141 delete $$options{UserParam}{$param}; 2142 } elsif ($param eq 'RequestTags') { 2143 if (defined $newVal) { 2144 # parse list from delimited string if necessary 2145 my @reqList = (ref $newVal eq 'ARRAY') ? @$newVal : ($newVal =~ /[-\w?*:]+/g); 2146 ExpandShortcuts(\@reqList); 2147 # add to existing list 2148 $$options{$param} or $$options{$param} = [ ]; 2149 foreach (@reqList) { 2150 /^(.*:)?([-\w?*]*)#?$/ or next; 2151 push @{$$options{$param}}, lc($2) if $2; 2152 next unless $1; 2153 # add requested groups with trailing colon 2154 push @{$$options{$param}}, lc($_).':' foreach split /:/, $1; 2155 } 2156 } else { 2157 $$options{$param} = undef; # clear the list 2158 } 2159 } elsif ($param eq 'ListJoin') { 2160 $$options{$param} = $newVal; 2161 # set the old List and ListSep options for backward compatibility 2162 if (defined $newVal) { 2163 $$options{List} = 0; 2164 $$options{ListSep} = $newVal; 2165 } else { 2166 $$options{List} = 1; 2167 # (ListSep must be defined) 2168 } 2169 } elsif ($param eq 'List') { 2170 $$options{$param} = $newVal; 2171 # set the new ListJoin option for forward compatibility 2172 $$options{ListJoin} = $newVal ? undef : $$options{ListSep}; 2173 } elsif ($param eq 'Compact' or $param eq 'XMPShorthand') { 2174 # set Compact and XMPShorthand options, preserving backward compatibility 2175 my ($p, %compact); 2176 foreach $p ('Compact','XMPShorthand') { 2177 my $val = $param eq $p ? $newVal : $$options{Compact}{$p}; 2178 if (defined $val) { 2179 my @v = ($val =~ /\w+/g); 2180 my $opt = ($p eq 'Compact') ? \%compactOpt : \%xmpShorthandOpt; 2181 foreach (@v) { 2182 my $set = $$opt{lc $_} or warn("Invalid $p setting '${_}'\n"), return $oldVal; 2183 ref $set or $compact{$set} = 1, next; 2184 $compact{$_} = 1 foreach @$set; 2185 } 2186 } 2187 $compact{$p} = $val; # preserve most recent setting 2188 } 2189 $$options{Compact} = $$options{XMPShorthand} = \%compact; 1270 2190 } else { 1271 2191 if ($param eq 'Escape') { … … 1281 2201 } 1282 2202 # must forget saved values since they depend on Escape method 1283 $self->{BOTH} = { }; 2203 $$self{BOTH} = { }; 2204 } elsif ($param eq 'GlobalTimeShift') { 2205 delete $$self{GLOBAL_TIME_OFFSET}; # reset our calculated offset 2206 } elsif ($param eq 'TimeZone' and defined $newVal and length $newVal) { 2207 $ENV{TZ} = $newVal; 2208 eval { require POSIX; POSIX::tzset() }; 2209 } elsif ($param eq 'Validate') { 2210 # load Validate module if Validate option enabled 2211 $newVal and require Image::ExifTool::Validate; 1284 2212 } 1285 2213 $$options{$param} = $newVal; … … 1298 2226 1299 2227 # create options hash with default values 1300 # (commented out options don't need initializing)1301 2228 # +-----------------------------------------------------+ 1302 2229 # ! DON'T FORGET!! When adding any new option, must ! 1303 2230 # ! decide how it is handled in SetNewValuesFromFile() ! 1304 2231 # +-----------------------------------------------------+ 1305 $self->{OPTIONS} = { 1306 # Binary => undef, # flag to extract binary values even if tag not specified 1307 # ByteOrder => undef, # default byte order when creating EXIF information 2232 # (Note: All options must exist in this lookup, even if undefined, 2233 # to facilitate case-insensitive options. 'Group#' is handled specially) 2234 $$self{OPTIONS} = { 2235 Binary => undef, # flag to extract binary values even if tag not specified 2236 ByteOrder => undef, # default byte order when creating EXIF information 1308 2237 Charset => 'UTF8', # character set for converting Unicode characters 2238 CharsetEXIF => undef, # internal EXIF "ASCII" string encoding 2239 CharsetFileName => undef, # external encoding for file names 1309 2240 CharsetID3 => 'Latin', # internal ID3v1 character set 1310 2241 CharsetIPTC => 'Latin', # fallback IPTC character set if no CodedCharacterSet 1311 # Compact => undef, # compact XMP and IPTC data 2242 CharsetPhotoshop => 'Latin', # internal encoding for Photoshop resource names 2243 CharsetQuickTime => 'MacRoman', # internal QuickTime string encoding 2244 CharsetRIFF => 0, # internal RIFF string encoding (0=default to Latin) 2245 Compact => { }, # write compact XMP 1312 2246 Composite => 1, # flag to calculate Composite tags 1313 #Compress => undef, # flag to write new values as compressed if possible1314 #CoordFormat => undef, # GPS lat/long coordinate format1315 #DateFormat => undef, # format for date/time2247 Compress => undef, # flag to write new values as compressed if possible 2248 CoordFormat => undef, # GPS lat/long coordinate format 2249 DateFormat => undef, # format for date/time 1316 2250 Duplicates => 1, # flag to save duplicate tag values 1317 # Escape => undef, # escape special characters 1318 # Exclude => undef, # tags to exclude 1319 # ExtractEmbedded =>undef,# flag to extract information from embedded documents 1320 # FastScan => undef, # flag to avoid scanning for trailer 1321 # FixBase => undef, # fix maker notes base offsets 1322 # GeoMaxIntSecs => undef, # geotag maximum interpolation time (secs) 1323 # GeoMaxExtSecs => undef, # geotag maximum extrapolation time (secs) 1324 # GeoMaxHDOP => undef, # geotag maximum HDOP 1325 # GeoMaxPDOP => undef, # geotag maximum PDOP 1326 # GeoMinSats => undef, # geotag minimum satellites 2251 Escape => undef, # escape special characters 2252 Exclude => undef, # tags to exclude 2253 ExtendedXMP => 1, # strategy for reading extended XMP 2254 ExtractEmbedded =>undef,# flag to extract information from embedded documents 2255 FastScan => undef, # flag to avoid scanning for trailer 2256 Filter => undef, # output filter for all tag values 2257 FilterW => undef, # input filter when writing tag values 2258 FixBase => undef, # fix maker notes base offsets 2259 GeoMaxIntSecs => 1800, # geotag maximum interpolation time (secs) 2260 GeoMaxExtSecs => 1800, # geotag maximum extrapolation time (secs) 2261 GeoMaxHDOP => undef, # geotag maximum HDOP 2262 GeoMaxPDOP => undef, # geotag maximum PDOP 2263 GeoMinSats => undef, # geotag minimum satellites 2264 GeoSpeedRef => undef, # geotag GPSSpeedRef 2265 GlobalTimeShift => undef, # apply time shift to all extracted date/time values 1327 2266 # Group# => undef, # return tags for specified groups in family # 2267 HexTagIDs => 0, # use hex tag ID's in family 7 group names 1328 2268 HtmlDump => 0, # HTML dump (0-3, higher # = bigger limit) 1329 #HtmlDumpBase => undef, # base address for HTML dump1330 #IgnoreMinorErrors => undef, # ignore minor errors when reading/writing2269 HtmlDumpBase => undef, # base address for HTML dump 2270 IgnoreMinorErrors => undef, # ignore minor errors when reading/writing 1331 2271 Lang => $defaultLang,# localized language for descriptions etc 1332 # LargeFileSupport => undef, # flag indicating support of 64-bit file offsets 1333 # List => undef, # extract lists of PrintConv values into arrays 1334 ListSep => ', ', # list item separator 1335 # ListSplit => undef, # regex for splitting list-type tag values when writing 1336 # MakerNotes => undef, # extract maker notes as a block 1337 # MissingTagValue =>undef,# value for missing tags when expanded in expressions 1338 # Password => undef, # password for password-protected PDF documents 2272 LargeFileSupport => undef, # flag indicating support of 64-bit file offsets 2273 List => undef, # extract lists of PrintConv values into arrays [no longer documented] 2274 ListItem => undef, # used to return a specific item from lists 2275 ListJoin => ', ', # join lists together with this separator 2276 ListSep => ', ', # list item separator [no longer documented] 2277 ListSplit => undef, # regex for splitting list-type tag values when writing 2278 MakerNotes => undef, # extract maker notes as a block 2279 MDItemTags => undef, # extract MacOS metadata item tags 2280 MissingTagValue =>undef,# value for missing tags when expanded in expressions 2281 NoMultiExif => undef, # raise error when writing multi-segment EXIF 2282 NoPDFList => undef, # flag to avoid splitting PDF List-type tag values 2283 Password => undef, # password for password-protected PDF documents 1339 2284 PrintConv => 1, # flag to enable print conversion 1340 # SavePath => undef, # (undocumented) save family 5 location path 1341 # ScanForXMP => undef, # flag to scan for XMP information in all files 1342 Sort => 'Input', # order to sort found tags (Input, File, Alpha, Group#) 1343 # StrictDate => undef, # flag to return undef for invalid date conversions 1344 # Struct => undef, # return structures as hash references 2285 QuickTimeHandler => 1, # flag to add mdir Handler to newly created Meta box 2286 QuickTimeUTC=> undef, # assume that QuickTime date/time tags are stored as UTC 2287 RequestAll => undef, # extract all tags that must be specifically requested 2288 RequestTags => undef, # extra tags to request (on top of those in the tag list) 2289 SaveFormat => undef, # save family 6 tag TIFF format 2290 SavePath => undef, # save family 5 location path 2291 ScanForXMP => undef, # flag to scan for XMP information in all files 2292 Sort => 'Input', # order to sort found tags (Input, File, Tag, Descr, Group#) 2293 Sort2 => 'File', # secondary sort order for tags in a group (File, Tag, Descr) 2294 StrictDate => undef, # flag to return undef for invalid date conversions 2295 Struct => undef, # return structures as hash references 2296 SystemTags => undef, # extract additional File System tags 1345 2297 TextOut => \*STDOUT,# file for Verbose/HtmlDump output 2298 TimeZone => undef, # local time zone 1346 2299 Unknown => 0, # flag to get values of unknown tags (0-2) 2300 UserParam => { }, # user parameters for additional user-defined tag values 2301 Validate => undef, # perform additional validation 1347 2302 Verbose => 0, # print verbose messages (0-5, higher # = more verbose) 2303 WriteMode => 'wcg', # enable all write modes by default 2304 XAttrTags => undef, # extract MacOS extended attribute tags 2305 XMPAutoConv => 1, # automatic conversion of unknown XMP tag values 2306 XMPShorthand=> 0, # (unused, but needed for backward compatibility) 1348 2307 }; 1349 2308 # keep necessary member variables in sync with options … … 1370 2329 local $_; 1371 2330 my $self = shift; 1372 my $options = $self->{OPTIONS}; # pointer to current options 1373 my (%saveOptions, $reEntry, $rsize); 2331 my $options = $$self{OPTIONS}; # pointer to current options 2332 my $fast = $$options{FastScan} || 0; 2333 my $req = $$self{REQ_TAG_LOOKUP}; 2334 my $reqAll = $$options{RequestAll} || 0; 2335 my (%saveOptions, $reEntry, $rsize, $type, @startTime, $saveOrder, $isDir); 1374 2336 1375 2337 # check for internal ReEntry option to allow recursive calls to ExtractInfo … … 1385 2347 FILE_TYPE => $$self{FILE_TYPE}, 1386 2348 }; 1387 $self->{RAF} = new File::RandomAccess($_[0]); 2349 $saveOrder = GetByteOrder(), 2350 $$self{RAF} = new File::RandomAccess($_[0]); 1388 2351 $$self{PROCESSED} = { }; 1389 2352 delete $$self{EXIF_DATA}; 1390 2353 delete $$self{EXIF_POS}; 1391 2354 } else { 1392 if (defined $_[0] or $ options->{HtmlDump}) {2355 if (defined $_[0] or $$options{HtmlDump} or $$req{validate}) { 1393 2356 %saveOptions = %$options; # save original options 1394 2357 1395 2358 # require duplicates for html dump 1396 $self->Options(Duplicates => 1) if $options->{HtmlDump}; 1397 2359 $self->Options(Duplicates => 1) if $$options{HtmlDump}; 2360 # enable Validate option if Validate tag is requested 2361 $self->Options(Validate => 1) if $$req{validate}; 2362 1398 2363 if (defined $_[0]) { 1399 2364 # only initialize filename if called with arguments 1400 $ self->{FILENAME} = undef;# name of file (or '' if we didn't open it)1401 $ self->{RAF} = undef;# RandomAccess object reference1402 2365 $$self{FILENAME} = undef; # name of file (or '' if we didn't open it) 2366 $$self{RAF} = undef; # RandomAccess object reference 2367 1403 2368 $self->ParseArguments(@_); # initialize from our arguments 1404 2369 } … … 1407 2372 $self->Init(); 1408 2373 1409 delete $ self->{MAKER_NOTE_FIXUP};# fixup information for extracted maker notes1410 delete $ self->{MAKER_NOTE_BYTE_ORDER};2374 delete $$self{MAKER_NOTE_FIXUP}; # fixup information for extracted maker notes 2375 delete $$self{MAKER_NOTE_BYTE_ORDER}; 1411 2376 1412 2377 # return our version number 1413 2378 $self->FoundTag('ExifToolVersion', "$VERSION$RELEASE"); 1414 $self->FoundTag('Now', time()) if $self->{REQ_TAG_LOOKUP}{now} or $self->{TAGS_FROM_FILE}; 1415 } 1416 my $filename = $self->{FILENAME}; # image file name ('' if already open) 1417 my $raf = $self->{RAF}; # RandomAccess object 2379 $self->FoundTag('Now', $self->TimeNow()) if $$req{now} or $reqAll; 2380 $self->FoundTag('NewGUID', NewGUID()) if $$req{newguid} or $reqAll; 2381 # generate sequence number if necessary 2382 $self->FoundTag('FileSequence', $$self{FILE_SEQUENCE}) if $$req{filesequence} or $reqAll; 2383 2384 if ($$req{processingtime} or $reqAll) { 2385 eval { require Time::HiRes; @startTime = Time::HiRes::gettimeofday() }; 2386 if (not @startTime and $$req{processingtime}) { 2387 $self->WarnOnce('Install Time::HiRes to generate ProcessingTime'); 2388 } 2389 } 2390 2391 ++$$self{FILE_SEQUENCE}; # count files read 2392 } 2393 2394 my $filename = $$self{FILENAME}; # image file name ('' if already open) 2395 my $raf = $$self{RAF}; # RandomAccess object 1418 2396 1419 2397 local *EXIFTOOL_FILE; # avoid clashes with global namespace … … 1425 2403 unless ($filename eq '-') { 1426 2404 # extract file name from pipe if necessary 1427 $realname =~ /\|$/ and $realname =~ s/.*?"(.*?)".*/$1/; 1428 my ($dir, $name); 1429 if (eval 'require File::Basename') { 1430 $dir = File::Basename::dirname($realname); 1431 $name = File::Basename::basename($realname); 1432 } else { 1433 ($name = $realname) =~ tr/\\/\//; 1434 # remove path 1435 $dir = length($1) ? $1 : '/' if $name =~ s/(.*)\///; 1436 } 2405 $realname =~ /\|$/ and $realname =~ s/^.*?"(.*?)".*/$1/s; 2406 my ($dir, $name) = SplitFileName($realname); 1437 2407 $self->FoundTag('FileName', $name); 1438 2408 $self->FoundTag('Directory', $dir) if defined $dir and length $dir; 2409 if ($$req{filepath} or 2410 ($reqAll and not $$self{EXCL_TAG_LOOKUP}{filepath})) 2411 { 2412 local $SIG{'__WARN__'} = \&SetWarning; 2413 if (eval { require Cwd }) { 2414 my $path = eval { Cwd::abs_path($filename) }; 2415 $self->FoundTag('FilePath', $path) if defined $path; 2416 } elsif ($$req{filepath}) { 2417 $self->WarnOnce('The Perl Cwd module must be installed to use FilePath'); 2418 } 2419 } 1439 2420 # get size of resource fork on Mac OS 1440 $rsize = -s "$filename/ rsrc" if $^O eq 'darwin' and not $$self{IN_RESOURCE};2421 $rsize = -s "$filename/..namedfork/rsrc" if $^O eq 'darwin' and not $$self{IN_RESOURCE}; 1441 2422 } 1442 2423 # open the file 1443 if ( open(EXIFTOOL_FILE, $filename)) {2424 if ($self->Open(\*EXIFTOOL_FILE, $filename)) { 1444 2425 # create random access file object 1445 2426 $raf = new File::RandomAccess(\*EXIFTOOL_FILE); 1446 2427 # patch to force pipe to be buffered because seek returns success 1447 2428 # in Windows cmd shell pipe even though it really failed 1448 $raf->{TESTED} = -1 if $filename eq '-' or $filename =~ /\|$/; 1449 $self->{RAF} = $raf; 2429 $$raf{TESTED} = -1 if $filename eq '-' or $filename =~ /\|$/; 2430 $$self{RAF} = $raf; 2431 } elsif ($self->IsDirectory($filename)) { 2432 $isDir = 1; 1450 2433 } else { 1451 2434 $self->Error('Error opening file'); … … 1456 2439 } 1457 2440 1458 if ($raf) { 2441 while ($raf or $isDir) { 2442 my (@stat, $plainFile); 1459 2443 if ($reEntry) { 1460 2444 # we already set these tags 1461 } elsif (not $raf->{FILE_PT}) { 2445 } elsif (not $raf) { 2446 @stat = stat $filename; 2447 } elsif (not $$raf{FILE_PT}) { 1462 2448 # get file size from image in memory 1463 $self->FoundTag('FileSize', length ${$raf->{BUFF_PT}}); 1464 } elsif (-f $raf->{FILE_PT}) { 1465 # get file size and last modified time if this is a plain file 1466 my $fileSize = -s _; 1467 my $fileTime = -M _; 1468 my @stat = stat _; 1469 $self->FoundTag('FileSize', $fileSize) if defined $fileSize; 1470 $self->FoundTag('ResourceForkSize', $rsize) if $rsize; 1471 $self->FoundTag('FileModifyDate', $^T - $fileTime*(24*3600)) if defined $fileTime; 1472 $self->FoundTag('FilePermissions', $stat[2]) if defined $stat[2]; 1473 } 1474 2449 $self->FoundTag('FileSize', length ${$$raf{BUFF_PT}}); 2450 } elsif (-f $$raf{FILE_PT}) { 2451 # get file tags if this is a plain file 2452 @stat = stat _; 2453 $plainFile = 1; 2454 } else { 2455 @stat = stat $$raf{FILE_PT}; 2456 } 2457 my $fileSize = $stat[7]; 2458 $self->FoundTag('FileSize', $stat[7]) if defined $stat[7]; 2459 $self->FoundTag('ResourceForkSize', $rsize) if $rsize; 2460 $self->FoundTag('FileModifyDate', $stat[9]) if defined $stat[9]; 2461 $self->FoundTag('FileAccessDate', $stat[8]) if defined $stat[8]; 2462 my $cTag = $^O eq 'MSWin32' ? 'FileCreateDate' : 'FileInodeChangeDate'; 2463 $self->FoundTag($cTag, $stat[10]) if defined $stat[10]; 2464 $self->FoundTag('FilePermissions', $stat[2]) if defined $stat[2]; 2465 # extract more system info if SystemTags option is set 2466 if (@stat) { 2467 my $sys = $$options{SystemTags} || ($reqAll and not defined $$options{SystemTags}); 2468 if ($sys or $$req{fileattributes}) { 2469 my @attr = ($stat[2] & 0xf000, $stat[2] & 0x0e00); 2470 # add Windows file attributes if available 2471 if ($^O eq 'MSWin32' and defined $filename and $filename ne '' and $filename ne '-') { 2472 local $SIG{'__WARN__'} = \&SetWarning; 2473 if (eval { require Win32API::File }) { 2474 my $wattr; 2475 my $file = $filename; 2476 if ($self->EncodeFileName($file)) { 2477 $wattr = eval { Win32API::File::GetFileAttributesW($file) }; 2478 } else { 2479 $wattr = eval { Win32API::File::GetFileAttributes($file) }; 2480 } 2481 push @attr, $wattr if defined $wattr and $wattr != 0xffffffff; 2482 } 2483 } 2484 $self->FoundTag('FileAttributes', "@attr"); 2485 } 2486 $self->FoundTag('FileDeviceNumber', $stat[0]) if $sys or $$req{filedevicenumber}; 2487 $self->FoundTag('FileInodeNumber', $stat[1]) if $sys or $$req{fileinodenumber}; 2488 $self->FoundTag('FileHardLinks', $stat[3]) if $sys or $$req{filehardlinks}; 2489 $self->FoundTag('FileUserID', $stat[4]) if $sys or $$req{fileuserid}; 2490 $self->FoundTag('FileGroupID', $stat[5]) if $sys or $$req{filegroupid}; 2491 $self->FoundTag('FileDeviceID', $stat[6]) if $sys or $$req{filedeviceid}; 2492 $self->FoundTag('FileBlockSize', $stat[11]) if $sys or $$req{fileblocksize}; 2493 $self->FoundTag('FileBlockCount', $stat[12]) if $sys or $$req{fileblockcount}; 2494 } 2495 # extract MDItem tags if requested (only on plain files) 2496 if ($^O eq 'darwin' and defined $filename and $filename ne '' and defined $fileSize) { 2497 my $reqMacOS = ($reqAll > 1 or $$req{'macos:'}); 2498 my $crDate = ($reqMacOS || $$req{filecreatedate}); 2499 my $mdItem = ($reqMacOS || $$options{MDItemTags} || grep /^mditem/, keys %$req); 2500 my $xattr = ($reqMacOS || $$options{XAttrTags} || grep /^xattr/, keys %$req); 2501 if ($crDate or $mdItem or $xattr) { 2502 require Image::ExifTool::MacOS; 2503 Image::ExifTool::MacOS::GetFileCreateDate($self, $filename) if $crDate; 2504 Image::ExifTool::MacOS::ExtractMDItemTags($self, $filename) if $mdItem and $plainFile; 2505 Image::ExifTool::MacOS::ExtractXAttrTags($self, $filename) if $xattr; 2506 } 2507 } 2508 # do whatever else we can with directories, then return 2509 if ($isDir or (defined $stat[2] and ($stat[2] & 0170000) == 0040000)) { 2510 $self->FoundTag('FileType', 'DIR'); 2511 $self->FoundTag('FileTypeExtension', ''); 2512 $self->BuildCompositeTags() if $$options{Composite}; 2513 $raf->Close() if $raf; 2514 return 1; 2515 } 1475 2516 # get list of file types to check 1476 my ($tiffType, %noMagic); 1477 $self->{FILE_EXT} = GetFileExtension($realname); 2517 my ($tiffType, %noMagic, $recognizedExt); 2518 my $ext = $$self{FILE_EXT} = GetFileExtension($realname); 2519 # set $recognizedExt if this file type is recognized by extension only 2520 $recognizedExt = $ext if defined $ext and not defined $magicNumber{$ext} and 2521 defined $moduleName{$ext} and not $moduleName{$ext}; 1478 2522 my @fileTypeList = GetFileType($realname); 2523 if ($fast >= 4) { 2524 if (@fileTypeList) { 2525 $type = shift @fileTypeList; 2526 $self->SetFileType($$self{FILE_TYPE} = $type); 2527 } else { 2528 $self->Error('Unknown file type'); 2529 } 2530 $self->BuildCompositeTags() if $fast == 4 and $$options{Composite}; 2531 last; # don't read the file 2532 } 1479 2533 if (@fileTypeList) { 1480 2534 # add remaining types to end of list so we test them all 1481 2535 my $pat = join '|', @fileTypeList; 1482 2536 push @fileTypeList, grep(!/^($pat)$/, @fileTypes); 1483 $tiffType = $self->{FILE_EXT}; 1484 $noMagic{MXF} = 1; # don't do magic number test on MXF or DV files 1485 $noMagic{DV} = 1; 2537 $tiffType = $$self{FILE_EXT}; 2538 unless ($fast == 3) { 2539 $noMagic{MXF} = 1; # don't do magic number test on MXF or DV files 2540 $noMagic{DV} = 1; 2541 } 1486 2542 } else { 1487 2543 # scan through all recognized file types … … 1493 2549 $raf->BinMode(); # set binary mode before we start reading 1494 2550 my $pos = $raf->Tell(); # get file position so we can rewind 1495 my %dirInfo = ( RAF => $raf, Base => $pos );1496 2551 # loop through list of file types to test 1497 my ($type, $buff, $seekErr); 1498 # read first 1024 bytes of file for testing 1499 $raf->Read($buff, 1024) or $buff = ''; 2552 my ($buff, $seekErr); 2553 my %dirInfo = ( RAF => $raf, Base => $pos, TestBuff => \$buff ); 2554 # read start of file for testing 2555 $raf->Read($buff, $testLen) or $buff = ''; 1500 2556 $raf->Seek($pos, 0) or $seekErr = 1; 1501 2557 until ($seekErr) { 2558 my $unkHeader; 1502 2559 $type = shift @fileTypeList; 1503 2560 if ($type) { 1504 # do quick test for this file type to avoid loading module unnecessarily 1505 next if $magicNumber{$type} and $buff !~ /^$magicNumber{$type}/s and 1506 not $noMagic{$type}; 2561 if ($magicNumber{$type}) { 2562 # do quick test for this file type to avoid loading module unnecessarily 2563 next if $buff !~ /^$magicNumber{$type}/s and not $noMagic{$type}; 2564 } else { 2565 # keep checking for other types if we recognize this file only by extension 2566 next if defined $moduleName{$type} and not $moduleName{$type}; 2567 next if $fast > 2; # keep checking if we aren't processing the file 2568 } 2569 next if $weakMagic{$type} and defined $recognizedExt; 2570 } elsif (not defined $type) { 2571 last; 2572 } elsif ($recognizedExt) { 2573 $type = $recognizedExt; # set type from recognized file extension only 1507 2574 } else { 1508 last unless defined $type;1509 2575 # last ditch effort to scan past unknown header for JPEG/TIFF 1510 2576 next unless $buff =~ /(\xff\xd8\xff|MM\0\x2a|II\x2a\0)/g; … … 1513 2579 $dirInfo{Base} = $pos + $skip; 1514 2580 $raf->Seek($pos + $skip, 0) or $seekErr = 1, last; 1515 $self->Warn("Skipped unknown $skip byte header"); 2581 $self->Warn("Processing $type-like data after unknown $skip-byte header"); 2582 $unkHeader = 1 unless $$self{DOC_NUM}; 1516 2583 } 1517 2584 # save file type in member variable 1518 $ self->{FILE_TYPE} = $self->{PATH}[0]= $type;2585 $$self{FILE_TYPE} = $type; 1519 2586 $dirInfo{Parent} = ($type eq 'TIFF') ? $tiffType : $type; 2587 # don't process the file when FastScan == 3 2588 if ($fast == 3 and not $processType{$type}) { 2589 unless ($weakMagic{$type} and (not $ext or $ext ne $type)) { 2590 $self->SetFileType($dirInfo{Parent}); 2591 } 2592 last; 2593 } 1520 2594 my $module = $moduleName{$type}; 1521 2595 $module = $type unless defined $module; … … 1531 2605 last; 1532 2606 } 2607 push @{$$self{PATH}}, $type; # save file type in metadata PATH 2608 1533 2609 # process the file 1534 2610 no strict 'refs'; 1535 &$func($self, \%dirInfo) and last;2611 my $result = &$func($self, \%dirInfo); 1536 2612 use strict 'refs'; 1537 2613 2614 pop @{$$self{PATH}}; 2615 2616 if ($result) { # all done if successful 2617 if ($unkHeader) { 2618 $self->DeleteTag('FileType'); 2619 $self->DeleteTag('FileTypeExtension'); 2620 $self->DeleteTag('MIMEType'); 2621 $self->VPrint(0,"Reset file type due to unknown header\n"); 2622 } 2623 last; 2624 } 1538 2625 # seek back to try again from the same position in the file 1539 2626 $raf->Seek($pos, 0) or $seekErr = 1, last; 2627 } 2628 if (not defined $type and not $$self{DOC_NUM}) { 2629 # if we were given a single image with a known type there 2630 # must be a format error since we couldn't read it, otherwise 2631 # it is likely we don't support images of this type 2632 my $fileType = GetFileType($realname) || ''; 2633 my $err; 2634 if (not length $buff) { 2635 $err = 'File is empty'; 2636 } else { 2637 my $ch = substr($buff, 0, 1); 2638 if (length $buff < 16 or $buff =~ /[^\Q$ch\E]/) { 2639 if ($fileType eq 'RAW') { 2640 $err = 'Unsupported RAW file type'; 2641 } elsif ($fileType) { 2642 $err = 'File format error'; 2643 } else { 2644 $err = 'Unknown file type'; 2645 } 2646 } else { 2647 # provide some insight into the content of some corrupted files 2648 if ($$self{OPTIONS}{FastScan}) { 2649 $err = 'File header is all'; 2650 } else { 2651 my $num = 0; 2652 for (;;) { 2653 $raf->Read($buff, 65536) or undef($num), last; 2654 $buff =~ /[^\Q$ch\E]/g and $num += pos($buff) - 1, last; 2655 $num += length($buff); 2656 } 2657 if ($num) { 2658 $err = 'First ' . ConvertFileSize($num) . ' of file is'; 2659 } else { 2660 $err = 'Entire file is'; 2661 } 2662 } 2663 if ($ch eq "\0") { 2664 $err .= ' binary zeros'; 2665 } elsif ($ch eq ' ') { 2666 $err .= ' ASCII spaces'; 2667 } elsif ($ch =~ /[a-zA-Z0-9]/) { 2668 $err .= " ASCII '${ch}' characters"; 2669 } else { 2670 $err .= sprintf(" binary 0x%.2x's", ord $ch); 2671 } 2672 } 2673 } 2674 $self->Error($err); 1540 2675 } 1541 2676 if ($seekErr) { 1542 2677 $self->Error('Error seeking in file'); 1543 2678 } elsif ($self->Options('ScanForXMP') and (not defined $type or 1544 (not $ self->Options('FastScan')and not $$self{FoundXMP})))2679 (not $fast and not $$self{FoundXMP}))) 1545 2680 { 1546 2681 # scan for XMP … … 1549 2684 Image::ExifTool::XMP::ScanForXMP($self, $raf) and $type = ''; 1550 2685 } 1551 unless (defined $type) {1552 # if we were given a single image with a known type there1553 # must be a format error since we couldn't read it, otherwise1554 # it is likely we don't support images of this type1555 my $fileType = GetFileType($realname);1556 my $err;1557 if (not $fileType) {1558 $err = 'Unknown file type';1559 } elsif ($fileType eq 'RAW') {1560 $err = 'Unsupported RAW file type';1561 } else {1562 $err = 'File format error';1563 }1564 $self->Error($err);1565 }1566 2686 # extract binary EXIF data block only if requested 1567 if (defined $self->{EXIF_DATA} and length $$self{EXIF_DATA} > 16 and 1568 ($self->{REQ_TAG_LOOKUP}{exif} or $self->{OPTIONS}{Binary})) 2687 if (defined $$self{EXIF_DATA} and length $$self{EXIF_DATA} > 16 and 2688 ($$req{exif} or 2689 # (not extracted normally, so check TAGS_FROM_FILE) 2690 ($$self{TAGS_FROM_FILE} and not $$self{EXCL_TAG_LOOKUP}{exif}))) 1569 2691 { 1570 $self->FoundTag('EXIF', $ self->{EXIF_DATA});2692 $self->FoundTag('EXIF', $$self{EXIF_DATA}); 1571 2693 } 1572 2694 unless ($reEntry) { 1573 $ self->{PATH} = [ ];# reset PATH2695 $$self{PATH} = [ ]; # reset PATH 1574 2696 # calculate Composite tags 1575 $self->BuildCompositeTags() if $ options->{Composite};2697 $self->BuildCompositeTags() if $$options{Composite}; 1576 2698 # do our HTML dump if requested 1577 if ($ self->{HTML_DUMP}) {2699 if ($$self{HTML_DUMP}) { 1578 2700 $raf->Seek(0, 2); # seek to end of file 1579 $self->{HTML_DUMP}->FinishTiffDump($self, $raf->Tell()); 1580 my $pos = $options->{HtmlDumpBase}; 1581 $pos = ($self->{FIRST_EXIF_POS} || 0) unless defined $pos; 1582 my $dataPt = defined $self->{EXIF_DATA} ? \$self->{EXIF_DATA} : undef; 1583 undef $dataPt if defined $self->{EXIF_POS} and $pos != $self->{EXIF_POS}; 1584 my $success = $self->{HTML_DUMP}->Print($raf, $dataPt, $pos, 1585 $options->{TextOut}, $options->{HtmlDump}, 1586 $self->{FILENAME} ? "HTML Dump ($self->{FILENAME})" : 'HTML Dump'); 1587 $self->Warn("Error reading $self->{HTML_DUMP}{ERROR}") if $success < 0; 2701 $$self{HTML_DUMP}->FinishTiffDump($self, $raf->Tell()); 2702 my $pos = $$options{HtmlDumpBase}; 2703 $pos = ($$self{FIRST_EXIF_POS} || 0) unless defined $pos; 2704 my $dataPt = defined $$self{EXIF_DATA} ? \$$self{EXIF_DATA} : undef; 2705 undef $dataPt if defined $$self{EXIF_POS} and $pos != $$self{EXIF_POS}; 2706 undef $dataPt if $$self{ExtendedEXIF}; # can't use EXIF block if not contiguous 2707 my $success = $$self{HTML_DUMP}->Print($raf, $dataPt, $pos, 2708 $$options{TextOut}, $$options{HtmlDump}, 2709 $$self{FILENAME} ? "HTML Dump ($$self{FILENAME})" : 'HTML Dump'); 2710 $self->Warn("Error reading $$self{HTML_DUMP}{ERROR}") if $success < 0; 1588 2711 } 1589 2712 } … … 1591 2714 $raf->Close(); # close the file if we opened it 1592 2715 # process the resource fork as an embedded file on Mac filesystems 1593 if ($rsize and $ options->{ExtractEmbedded}) {2716 if ($rsize and $$options{ExtractEmbedded}) { 1594 2717 local *RESOURCE_FILE; 1595 if ( open(RESOURCE_FILE, "$filename/rsrc")) {2718 if ($self->Open(\*RESOURCE_FILE, "$filename/..namedfork/rsrc")) { 1596 2719 $$self{DOC_NUM} = $$self{DOC_COUNT} + 1; 1597 2720 $$self{IN_RESOURCE} = 1; … … 1604 2727 } 1605 2728 } 2729 last; # (loop was a cheap "goto") 2730 } 2731 2732 # generate Validate tag if requested 2733 if ($$options{Validate} and not $reEntry) { 2734 Image::ExifTool::Validate::FinishValidate($self, $$req{validate}); 2735 } 2736 2737 @startTime and $self->FoundTag('ProcessingTime', Time::HiRes::tv_interval(\@startTime)); 2738 2739 # add user-defined parameters that ended with '!' 2740 if (%{$$options{UserParam}}) { 2741 my $doMsg = $$options{Verbose}; 2742 my $table = GetTagTable('Image::ExifTool::UserParam'); 2743 foreach (sort keys %{$$options{UserParam}}) { 2744 next unless /#$/; 2745 if ($doMsg) { 2746 $self->VPrint(0, "UserParam tags:\n"); 2747 undef $doMsg; 2748 } 2749 $self->HandleTag($table, $_, $$options{UserParam}{$_}); 2750 } 1606 2751 } 1607 2752 1608 2753 # restore original options 1609 %saveOptions and $ self->{OPTIONS} = \%saveOptions;2754 %saveOptions and $$self{OPTIONS} = \%saveOptions; 1610 2755 1611 2756 if ($reEntry) { 1612 2757 # restore necessary members when exiting re-entrant code 1613 2758 $$self{$_} = $$reEntry{$_} foreach keys %$reEntry; 1614 } 1615 1616 return exists $self->{VALUE}{Error} ? 0 : 1; 2759 SetByteOrder($saveOrder); 2760 } 2761 2762 # ($type may be undef without an Error when processing sub-documents) 2763 return 0 if not defined $type or exists $$self{VALUE}{Error}; 2764 return 1; 1617 2765 } 1618 2766 … … 1633 2781 1634 2782 unless (@_ and not defined $_[0]) { 1635 %saveOptions = %{$ self->{OPTIONS}}; # save original options2783 %saveOptions = %{$$self{OPTIONS}}; # save original options 1636 2784 # must set FILENAME so it isn't parsed from the arguments 1637 $ self->{FILENAME} = '' unless defined $self->{FILENAME};2785 $$self{FILENAME} = '' unless defined $$self{FILENAME}; 1638 2786 $self->ParseArguments(@_); 1639 2787 } 1640 2788 1641 2789 # get reference to list of tags for which we will return info 1642 my ($rtnTags, $byValue ) = $self->SetFoundTags();2790 my ($rtnTags, $byValue, $wildTags) = $self->SetFoundTags(); 1643 2791 1644 2792 # build hash of tag information 1645 2793 my (%info, %ignored); 1646 my $conv = $ self->{OPTIONS}{PrintConv} ? 'PrintConv' : 'ValueConv';2794 my $conv = $$self{OPTIONS}{PrintConv} ? 'PrintConv' : 'ValueConv'; 1647 2795 foreach (@$rtnTags) { 1648 2796 my $val = $self->GetValue($_, $conv); … … 1652 2800 1653 2801 # override specified tags with ValueConv value if necessary 1654 if (@$byValue and $conv ne 'ValueConv') {2802 if (@$byValue) { 1655 2803 # first determine the number of times each non-ValueConv value is used 1656 2804 my %nonVal; … … 1665 2813 # generate a new tag key like "Tag #" or "Tag #(1)" 1666 2814 $vtag =~ s/( |$)/ #/; 1667 unless (defined $ self->{VALUE}->{$vtag}) {1668 $ self->{VALUE}{$vtag} = $self->{VALUE}{$tag};1669 $ self->{TAG_INFO}{$vtag} = $self->{TAG_INFO}{$tag};1670 $ self->{TAG_EXTRA}{$vtag} = $self->{TAG_EXTRA}{$tag};1671 $ self->{FILE_ORDER}{$vtag} = $self->{FILE_ORDER}{$tag};2815 unless (defined $$self{VALUE}{$vtag}) { 2816 $$self{VALUE}{$vtag} = $$self{VALUE}{$tag}; 2817 $$self{TAG_INFO}{$vtag} = $$self{TAG_INFO}{$tag}; 2818 $$self{TAG_EXTRA}{$vtag} = $$self{TAG_EXTRA}{$tag}; 2819 $$self{FILE_ORDER}{$vtag} = $$self{FILE_ORDER}{$tag}; 1672 2820 # remove existing PrintConv entry unless we are using it too 1673 2821 delete $info{$tag} unless $nonVal{$tag}; … … 1679 2827 1680 2828 # remove ignored tags from the list 1681 my $reqTags = $self->{REQUESTED_TAGS} || [ ]; 1682 if (%ignored and not @$reqTags) { 1683 my @goodTags; 1684 foreach (@$rtnTags) { 1685 push @goodTags, $_ unless $ignored{$_}; 1686 } 1687 $rtnTags = $self->{FOUND_TAGS} = \@goodTags; 2829 my $reqTags = $$self{REQUESTED_TAGS} || [ ]; 2830 if (%ignored) { 2831 if (not @$reqTags) { 2832 my @goodTags; 2833 foreach (@$rtnTags) { 2834 push @goodTags, $_ unless $ignored{$_}; 2835 } 2836 $rtnTags = $$self{FOUND_TAGS} = \@goodTags; 2837 } elsif (@$wildTags) { 2838 # only remove tags specified by wildcard 2839 my @goodTags; 2840 my $i = 0; 2841 foreach (@$rtnTags) { 2842 if (@$wildTags and $i == $$wildTags[0]) { 2843 shift @$wildTags; 2844 push @goodTags, $_ unless $ignored{$_}; 2845 } else { 2846 push @goodTags, $_; 2847 } 2848 ++$i; 2849 } 2850 $rtnTags = $$self{FOUND_TAGS} = \@goodTags; 2851 } 1688 2852 } 1689 2853 1690 2854 # return sorted tag list if provided with a list reference 1691 if ($ self->{IO_TAG_LIST}) {2855 if ($$self{IO_TAG_LIST}) { 1692 2856 # use file order by default if no tags specified 1693 2857 # (no such thing as 'Input' order in this case) 1694 my $sortOrder = $self->{OPTIONS}{Sort}; 1695 unless (@$reqTags or ($sortOrder and $sortOrder ne 'Input')) { 1696 $sortOrder = 'File'; 1697 } 2858 my $sort = $$self{OPTIONS}{Sort}; 2859 $sort = 'File' unless @$reqTags or ($sort and $sort ne 'Input'); 1698 2860 # return tags in specified sort order 1699 @{$ self->{IO_TAG_LIST}} = $self->GetTagList($rtnTags, $sortOrder);2861 @{$$self{IO_TAG_LIST}} = $self->GetTagList($rtnTags, $sort, $$self{OPTIONS}{Sort2}); 1700 2862 } 1701 2863 1702 2864 # restore original options 1703 %saveOptions and $ self->{OPTIONS} = \%saveOptions;2865 %saveOptions and $$self{OPTIONS} = \%saveOptions; 1704 2866 1705 2867 return \%info; 1706 }1707 1708 #------------------------------------------------------------------------------1709 # Combine information from a list of info hashes1710 # Unless Duplicates is enabled, first entry found takes priority1711 # Inputs: 0) ExifTool object reference, 1-N) list of info hash references1712 # Returns: Combined information hash reference1713 sub CombineInfo($;@)1714 {1715 local $_;1716 my $self = shift;1717 my (%combinedInfo, $info, $tag, %haveInfo);1718 1719 if ($self->{OPTIONS}{Duplicates}) {1720 while ($info = shift) {1721 foreach $tag (keys %$info) {1722 $combinedInfo{$tag} = $$info{$tag};1723 }1724 }1725 } else {1726 while ($info = shift) {1727 foreach $tag (keys %$info) {1728 my $tagName = GetTagName($tag);1729 next if $haveInfo{$tagName};1730 $haveInfo{$tagName} = 1;1731 $combinedInfo{$tag} = $$info{$tag};1732 }1733 }1734 }1735 return \%combinedInfo;1736 2868 } 1737 2869 … … 1740 2872 # 1) [optional] reference to info hash or tag list ref (default is found tags) 1741 2873 # 2) [optional] sort order ('File', 'Input', ...) 2874 # 3) [optional] secondary sort order 1742 2875 # Returns: List of tags in specified order 1743 sub GetTagList($;$$ )2876 sub GetTagList($;$$$) 1744 2877 { 1745 2878 local $_; 1746 my ($self, $info, $sort Order) = @_;2879 my ($self, $info, $sort, $sort2) = @_; 1747 2880 1748 2881 my $foundTags; … … 1753 2886 $foundTags = $info; 1754 2887 } 1755 my $fileOrder = $ self->{FILE_ORDER};2888 my $fileOrder = $$self{FILE_ORDER}; 1756 2889 1757 2890 if ($foundTags) { … … 1763 2896 } 1764 2897 } else { 1765 $sort Order = $info if $info and not $sortOrder;1766 $foundTags = $ self->{FOUND_TAGS} || $self->SetFoundTags() or return undef;1767 } 1768 $sort Order or $sortOrder = $self->{OPTIONS}{Sort};2898 $sort = $info if $info and not $sort; 2899 $foundTags = $$self{FOUND_TAGS} || $self->SetFoundTags() or return undef; 2900 } 2901 $sort or $sort = $$self{OPTIONS}{Sort}; 1769 2902 1770 2903 # return original list if no sort order specified 1771 return @$foundTags unless $sort Order and $sortOrderne 'Input';1772 1773 if ($sort Ordereq 'Alpha') {2904 return @$foundTags unless $sort and $sort ne 'Input'; 2905 2906 if ($sort eq 'Tag' or $sort eq 'Alpha') { 1774 2907 return sort @$foundTags; 1775 } elsif ($sort Order=~ /^Group(\d*(:\d+)*)/) {2908 } elsif ($sort =~ /^Group(\d*(:\d+)*)/) { 1776 2909 my $family = $1 || 0; 1777 2910 # want to maintain a basic file order with the groups … … 1786 2919 $groupOrder{$tag} = $num; 1787 2920 } 2921 $sort2 or $sort2 = $$self{OPTIONS}{Sort2}; 2922 if ($sort2) { 2923 if ($sort2 eq 'Tag' or $sort2 eq 'Alpha') { 2924 return sort { $groupOrder{$a} <=> $groupOrder{$b} or $a cmp $b } @$foundTags; 2925 } elsif ($sort2 eq 'Descr') { 2926 my $desc = $self->GetDescriptions($foundTags); 2927 return sort { $groupOrder{$a} <=> $groupOrder{$b} or 2928 $$desc{$a} cmp $$desc{$b} } @$foundTags; 2929 } 2930 } 1788 2931 return sort { $groupOrder{$a} <=> $groupOrder{$b} or 1789 2932 $$fileOrder{$a} <=> $$fileOrder{$b} } @$foundTags; 2933 } elsif ($sort eq 'Descr') { 2934 my $desc = $self->GetDescriptions($foundTags); 2935 return sort { $$desc{$a} cmp $$desc{$b} } @$foundTags; 1790 2936 } else { 1791 2937 return sort { $$fileOrder{$a} <=> $$fileOrder{$b} } @$foundTags; … … 1796 2942 # Get list of found tags in specified sort order 1797 2943 # Inputs: 0) ExifTool object reference, 1) sort order ('File', 'Input', ...) 2944 # 2) secondary sort order 1798 2945 # Returns: List of tag keys in specified order 1799 2946 # Notes: If not specified, sort order is taken from OPTIONS 1800 sub GetFoundTags($;$ )2947 sub GetFoundTags($;$$) 1801 2948 { 1802 2949 local $_; 1803 my ($self, $sort Order) = @_;1804 my $foundTags = $ self->{FOUND_TAGS} || $self->SetFoundTags() or return undef;1805 return $self->GetTagList($foundTags, $sort Order);2950 my ($self, $sort, $sort2) = @_; 2951 my $foundTags = $$self{FOUND_TAGS} || $self->SetFoundTags() or return undef; 2952 return $self->GetTagList($foundTags, $sort, $sort2); 1806 2953 } 1807 2954 … … 1819 2966 # Get tag value 1820 2967 # Inputs: 0) ExifTool object reference 1821 # 1) tag key (or flattened tagInfo for getting field values, not part of public API) 1822 # 2) [optional] Value type: PrintConv, ValueConv, Both or Raw, the default 2968 # 1) tag key or tag name with optional group names (case sensitive) 2969 # (or flattened tagInfo for getting field values, not part of public API) 2970 # 2) [optional] Value type: PrintConv, ValueConv, Both, Raw or Rational, the default 1823 2971 # is PrintConv or ValueConv, depending on the PrintConv option setting 1824 2972 # 3) raw field value (not part of public API) … … 1830 2978 my ($self, $tag, $type) = @_; # plus: ($fieldValue) 1831 2979 my (@convTypes, $tagInfo, $valueConv, $both); 1832 2980 my $rawValue = $$self{VALUE}; 2981 2982 # get specific tag key if tag has a group name 2983 if ($tag =~ /^(.*):(.+)/) { 2984 my ($gp, $tg) = ($1, $2); 2985 my ($i, $key, @keys); 2986 # build list of tag keys in the order of priority (no index 2987 # is top priority, otherwise higher index is higher priority) 2988 for ($key=$tg, $i=$$self{DUPL_TAG}{$tg} || 0; ; --$i) { 2989 push @keys, $key if defined $$rawValue{$key}; 2990 last if $i <= 0; 2991 $key = "$tg ($i)"; 2992 } 2993 if (@keys) { 2994 $key = $self->GroupMatches($gp, \@keys); 2995 $tag = $key if $key; 2996 } 2997 } 1833 2998 # figure out what conversions to do 1834 $type or $type = $self->{OPTIONS}{PrintConv} ? 'PrintConv' : 'ValueConv'; 2999 if ($type) { 3000 return $$self{RATIONAL}{$tag} if $type eq 'Rational'; 3001 } else { 3002 $type = $$self{OPTIONS}{PrintConv} ? 'PrintConv' : 'ValueConv'; 3003 } 1835 3004 1836 3005 # start with the raw value 1837 my $value = $ self->{VALUE}{$tag};3006 my $value = $$rawValue{$tag}; 1838 3007 if (not defined $value) { 1839 return wantarray ? () : undefunless ref $tag;3008 return () unless ref $tag; 1840 3009 # get the value of a structure field 1841 3010 $tagInfo = $tag; … … 1848 3017 } 1849 3018 } else { 1850 $tagInfo = $ self->{TAG_INFO}{$tag};3019 $tagInfo = $$self{TAG_INFO}{$tag}; 1851 3020 if ($$tagInfo{Struct} and ref $value) { 1852 3021 # must load XMPStruct.pl just in case (should already be loaded if … … 1856 3025 # convert strucure field values 1857 3026 unless ($type eq 'Both') { 1858 # (note: ConvertStruct handles the escapetoo if necessary)3027 # (note: ConvertStruct handles the filtering and escaping too if necessary) 1859 3028 return Image::ExifTool::XMP::ConvertStruct($self,$tagInfo,$value,$type); 1860 3029 } … … 1866 3035 if ($type ne 'Raw') { 1867 3036 # use values we calculated already if we stored them 1868 $both = $ self->{BOTH}{$tag};3037 $both = $$self{BOTH}{$tag}; 1869 3038 if ($both) { 1870 3039 if ($type eq 'PrintConv') { … … 1887 3056 foreach $convType (@convTypes) { 1888 3057 # don't convert a scalar reference or structure 1889 last if ref $value eq 'SCALAR' ;3058 last if ref $value eq 'SCALAR' and not $$tagInfo{ConvertBinary}; 1890 3059 my $conv = $$tagInfo{$convType}; 1891 3060 unless (defined $conv) { … … 1895 3064 } else { 1896 3065 # use PRINT_CONV from tag table if PrintConv doesn't exist 1897 next unless defined($conv = $ tagInfo->{Table}{PRINT_CONV});3066 next unless defined($conv = $$tagInfo{Table}{PRINT_CONV}); 1898 3067 next if exists $$tagInfo{$convType}; 1899 3068 } … … 1906 3075 $convList = $conv; 1907 3076 $conv = $$convList[0]; 1908 my @valList = split ' ', $value;3077 my @valList = (ref $value eq 'ARRAY') ? @$value : split ' ', $value; 1909 3078 # reorganize list if specified (Note: The writer currently doesn't 1910 3079 # relist values, so they may be grouped but the order must not change) … … 1928 3097 $value = \@valList; 1929 3098 } 3099 return () unless @$value; 1930 3100 } 1931 3101 # initialize array so we can iterate over values in list 1932 3102 if (ref $value eq 'ARRAY') { 1933 $i = 0; 1934 $vals = $value; 1935 $val = $$vals[0]; 3103 if (defined $$tagInfo{RawJoin}) { 3104 $val = join ' ', @$value; 3105 } else { 3106 $i = 0; 3107 $vals = $value; 3108 $val = $$vals[0]; 3109 } 1936 3110 } else { 1937 3111 $val = $value; … … 1945 3119 my $oldEscape = $$self{ESCAPE_PROC}; 1946 3120 delete $$self{ESCAPE_PROC}; 3121 # temporarily delete filter so it isn't applied to the Require'd values 3122 my $oldFilter = $$self{OPTIONS}{Filter}; 3123 delete $$self{OPTIONS}{Filter}; 1947 3124 foreach (keys %$val) { 1948 $raw[$_] = $self->{VALUE}{$$val{$_}}; 3125 next unless defined $$val{$_}; 3126 $raw[$_] = $$rawValue{$$val{$_}}; 1949 3127 ($val[$_], $prt[$_]) = $self->GetValue($$val{$_}, 'Both'); 1950 next if defined $val[$_] or not $tagInfo->{Require}{$_}; 3128 next if defined $val[$_] or not $$tagInfo{Require}{$_}; 3129 $$self{OPTIONS}{Filter} = $oldFilter if defined $oldFilter; 1951 3130 $$self{ESCAPE_PROC} = $oldEscape; 1952 return wantarray ? () : undef;3131 return (); 1953 3132 } 3133 $$self{OPTIONS}{Filter} = $oldFilter if defined $oldFilter; 1954 3134 $$self{ESCAPE_PROC} = $oldEscape; 1955 3135 # set $val to $val[0], or \@val for a CODE ref conversion … … 1958 3138 if (ref $conv eq 'HASH') { 1959 3139 # look up converted value in hash 1960 my $lc; 1961 if (defined($value = $$conv{$val})) { 1962 # override with our localized language PrintConv if available 1963 if ($$self{CUR_LANG} and $convType eq 'PrintConv' and 1964 # (no need to check for lang-alt tag names -- they won't have a PrintConv) 1965 ref($lc = $self->{CUR_LANG}{$$tagInfo{Name}}) eq 'HASH' and 1966 ($lc = $$lc{PrintConv}) and ($lc = $$lc{$value})) 1967 { 1968 $value = $self->Decode($lc, 'UTF8'); 3140 if (not defined($value = $$conv{$val})) { 3141 if ($$conv{BITMASK}) { 3142 $value = DecodeBits($val, $$conv{BITMASK}, $$tagInfo{BitsPerWord}); 3143 } else { 3144 # use alternate conversion routine if available 3145 if ($$conv{OTHER}) { 3146 local $SIG{'__WARN__'} = \&SetWarning; 3147 undef $evalWarning; 3148 $value = &{$$conv{OTHER}}($val, undef, $conv); 3149 $self->Warn("$convType $tag: " . CleanWarning()) if $evalWarning; 3150 } 3151 if (not defined $value) { 3152 if ($$tagInfo{PrintHex} and $val and IsInt($val) and 3153 $convType eq 'PrintConv') 3154 { 3155 $value = sprintf('Unknown (0x%x)',$val); 3156 } else { 3157 $value = "Unknown ($val)"; 3158 } 3159 } 1969 3160 } 1970 } else { 1971 if ($$conv{BITMASK}) { 1972 $value = DecodeBits($val, $$conv{BITMASK}); 1973 # override with localized language strings 1974 if (defined $value and $$self{CUR_LANG} and $convType eq 'PrintConv' and 1975 ref($lc = $self->{CUR_LANG}{$$tagInfo{Name}}) eq 'HASH' and 1976 ($lc = $$lc{PrintConv})) 1977 { 1978 my @vals = split ', ', $value; 1979 foreach (@vals) { 1980 $_ = $$lc{$_} if defined $$lc{$_}; 1981 } 1982 $value = join ', ', @vals; 3161 } 3162 # override with our localized language PrintConv if available 3163 my $tmp; 3164 if ($$self{CUR_LANG} and $convType eq 'PrintConv' and 3165 # (no need to check for lang-alt tag names -- they won't have a PrintConv) 3166 ref($tmp = $$self{CUR_LANG}{$$tagInfo{Name}}) eq 'HASH' and 3167 ($tmp = $$tmp{PrintConv})) 3168 { 3169 if ($$conv{BITMASK} and not defined $$conv{$val}) { 3170 my @vals = split ', ', $value; 3171 foreach (@vals) { 3172 $_ = $$tmp{$_} if defined $$tmp{$_}; 1983 3173 } 1984 } elsif (not $$conv{OTHER} or 1985 # use alternate conversion routine if available 1986 not defined($value = &{$$conv{OTHER}}($val, undef, $conv))) 1987 { 1988 if (($$tagInfo{PrintHex} or 1989 ($$tagInfo{Mask} and not defined $$tagInfo{PrintHex})) 1990 and $val and IsInt($val) and $convType eq 'PrintConv') 1991 { 1992 $val = sprintf('0x%x',$val); 1993 } 1994 $value = "Unknown ($val)"; 3174 $value = join ', ', @vals; 3175 } elsif (defined($tmp = $$tmp{$value})) { 3176 $value = $self->Decode($tmp, 'UTF8'); 1995 3177 } 1996 3178 } … … 2012 3194 } 2013 3195 last unless $vals; 3196 # must store a separate copy of each binary data value in the list 3197 if (ref $value eq 'SCALAR') { 3198 my $tval = $$value; 3199 $value = \$tval; 3200 } 2014 3201 # save this converted value and step to next value in list 2015 3202 push @values, $value if defined $value; … … 2019 3206 } 2020 3207 $val = $$vals[$i]; 2021 $conv = $$convList[$i] if $convList; 3208 if ($convList) { 3209 my $nextConv = $$convList[$i]; 3210 if ($nextConv and $nextConv eq 'REPEAT') { 3211 undef $convList; 3212 } else { 3213 $conv = $nextConv; 3214 } 3215 } 2022 3216 } 2023 3217 # return undefined now if no value 2024 return wantarray ? () : undefunless defined $value;3218 return () unless defined $value; 2025 3219 # join back into single value if split for conversion list 2026 3220 if ($convList and ref $value eq 'ARRAY') { … … 2031 3225 # save both (unescaped) values because we often need them again 2032 3226 # (Composite tags need "Both" and often Require one tag for various Composite tags) 2033 $ self->{BOTH}{$tag} = [ $valueConv, $value ] unless $both;3227 $$self{BOTH}{$tag} = [ $valueConv, $value ] unless $both; 2034 3228 # escape values if necessary 2035 3229 if ($$self{ESCAPE_PROC}) { … … 2044 3238 $valueConv = $value; 2045 3239 } 3240 $self->Filter($$self{OPTIONS}{Filter}, \$value); 2046 3241 # return Both values as a list (ValueConv, PrintConv) 2047 3242 return ($valueConv, $value); … … 2050 3245 DoEscape($value, $$self{ESCAPE_PROC}) if $$self{ESCAPE_PROC}; 2051 3246 3247 # filter if necessary 3248 $self->Filter($$self{OPTIONS}{Filter}, \$value) if $$self{OPTIONS}{Filter} and $type eq 'PrintConv'; 3249 2052 3250 if (ref $value eq 'ARRAY') { 2053 # return array if requested 2054 return @$value if wantarray; 2055 # return list reference for Raw, ValueConv or if List or not a list of scalars 2056 return $value if $type ne 'PrintConv' or $self->{OPTIONS}{List} or ref $$value[0]; 2057 # otherwise join in comma-separated string 2058 $value = join $self->{OPTIONS}{ListSep}, @$value; 3251 if (defined $$self{OPTIONS}{ListItem}) { 3252 $value = $$value[$$self{OPTIONS}{ListItem}]; 3253 } elsif (wantarray) { 3254 # return array if requested 3255 return @$value; 3256 } elsif ($type eq 'PrintConv' and not $$self{OPTIONS}{List} and not ref $$value[0]) { 3257 # join PrintConv values in comma-separated string if List option not used 3258 # and list contains simple scalars (otherwise return ARRAY ref) 3259 $value = join $$self{OPTIONS}{ListSep}, @$value; 3260 } 2059 3261 } 2060 3262 return $value; … … 2064 3266 # Get tag identification number 2065 3267 # Inputs: 0) ExifTool object reference, 1) tag key 2066 # Returns: Scalar context: Tag ID if available, otherwise ''2067 # List context: 0) Tag ID (or ''), 1) language code (or undef)3268 # Returns: Scalar context: tag ID if available, otherwise '' 3269 # List context: 0) tag ID (or ''), 1) language code (or undef) 2068 3270 sub GetTagID($$) 2069 3271 { 2070 3272 my ($self, $tag) = @_; 2071 my $tagInfo = $ self->{TAG_INFO}{$tag};3273 my $tagInfo = $$self{TAG_INFO}{$tag}; 2072 3274 return '' unless $tagInfo and defined $$tagInfo{TagID}; 2073 3275 return ($$tagInfo{TagID}, $$tagInfo{LangCode}) if wantarray; 2074 3276 return $$tagInfo{TagID}; 2075 }2076 2077 #------------------------------------------------------------------------------2078 # Get tag table name2079 # Inputs: 0) ExifTool object reference, 1) tag key2080 # Returns: Table name if available, otherwise ''2081 sub GetTableName($$)2082 {2083 my ($self, $tag) = @_;2084 my $tagInfo = $self->{TAG_INFO}{$tag} or return '';2085 return $tagInfo->{Table}{SHORT_NAME};2086 }2087 2088 #------------------------------------------------------------------------------2089 # Get tag index number2090 # Inputs: 0) ExifTool object reference, 1) tag key2091 # Returns: Table index number, or undefined if this tag isn't indexed2092 sub GetTagIndex($$)2093 {2094 my ($self, $tag) = @_;2095 my $tagInfo = $self->{TAG_INFO}{$tag} or return undef;2096 return $$tagInfo{Index};2097 3277 } 2098 3278 … … 2107 3287 my ($self, $tag) = @_; 2108 3288 my ($desc, $name); 2109 my $tagInfo = $ self->{TAG_INFO}{$tag};3289 my $tagInfo = $$self{TAG_INFO}{$tag}; 2110 3290 # ($tagInfo won't be defined for missing tags extracted with -f) 2111 3291 if ($tagInfo) { 2112 3292 # use alternate language description if available 2113 3293 while ($$self{CUR_LANG}) { 2114 $desc = $ self->{CUR_LANG}{$$tagInfo{Name}};3294 $desc = $$self{CUR_LANG}{$$tagInfo{Name}}; 2115 3295 if ($desc) { 2116 3296 # must look up Description if this tag also has a PrintConv … … 2120 3300 last unless $$tagInfo{LangCode} and 2121 3301 ($name = $$tagInfo{Name}) =~ s/-$$tagInfo{LangCode}$// and 2122 $desc = $ self->{CUR_LANG}{$name};3302 $desc = $$self{CUR_LANG}{$name}; 2123 3303 $desc = $$desc{Description} or last if ref $desc; 2124 3304 $desc .= " ($$tagInfo{LangCode})"; … … 2144 3324 # Inputs: 0) ExifTool object reference 2145 3325 # 1) tag key (or reference to tagInfo hash, not part of the public API) 2146 # 2) [optional] group family (-1 to get extended group list) 2147 # Returns: Scalar context: Group name (for family 0 if not otherwise specified) 2148 # Array context: Group name if family specified, otherwise list of 3326 # 2) [optional] group family (-1 to get extended group list, or multiple 3327 # families separated by colons to return multiple groups as a string) 3328 # Returns: Scalar context: group name (for family 0 if not otherwise specified) 3329 # List context: group name if family specified, otherwise list of 2149 3330 # group names for each family. Returns '' for undefined tag. 2150 # Notes: Mu tiple families may be specified with ':' in family argument (ie. '1:2')3331 # Notes: Multiple families may be specified with ':' in family argument (eg. '1:2') 2151 3332 sub GetGroup($$;$) 2152 3333 { 2153 3334 local $_; 2154 3335 my ($self, $tag, $family) = @_; 2155 my ($tagInfo, @groups, @families, $simplify, $byTagInfo );3336 my ($tagInfo, @groups, @families, $simplify, $byTagInfo, $ex, $noID); 2156 3337 if (ref $tag eq 'HASH') { 2157 3338 $tagInfo = $tag; … … 2160 3341 $byTagInfo = 1; 2161 3342 } else { 2162 $tagInfo = $self->{TAG_INFO}{$tag} or return ''; 3343 $tagInfo = $$self{TAG_INFO}{$tag} || { }; 3344 $ex = $$self{TAG_EXTRA}{$tag}; 2163 3345 } 2164 3346 my $groups = $$tagInfo{Groups}; … … 2166 3348 # (after this, Groups 0-2 in tagInfo are guaranteed to be defined) 2167 3349 unless ($$tagInfo{GotGroups}) { 2168 my $tagTablePtr = $$tagInfo{Table}; 2169 if ($tagTablePtr) { 2170 # construct our group list 2171 $groups or $groups = $$tagInfo{Groups} = { }; 2172 # fill in default groups 2173 foreach (keys %{$$tagTablePtr{GROUPS}}) { 2174 $$groups{$_} or $$groups{$_} = $tagTablePtr->{GROUPS}{$_}; 2175 } 3350 my $tagTablePtr = $$tagInfo{Table} || { GROUPS => { } }; 3351 # construct our group list 3352 $groups or $groups = $$tagInfo{Groups} = { }; 3353 # fill in default groups 3354 foreach (0..2) { 3355 $$groups{$_} = $$tagTablePtr{GROUPS}{$_} || '' unless $$groups{$_}; 2176 3356 } 2177 3357 # set flag indicating group list was built … … 2181 3361 if ($family =~ /[^\d]/) { 2182 3362 @families = ($family =~ /\d+/g); 2183 return $$groups{0}unless @families;3363 return(($ex && $$ex{G0}) || $$groups{0}) unless @families; 2184 3364 $simplify = 1 unless $family =~ /^:/; 2185 3365 undef $family; 2186 3366 foreach (0..2) { $groups[$_] = $$groups{$_}; } 3367 $noID = 1 if @families == 1 and $families[0] != 7; 2187 3368 } else { 2188 return $$groups{$family}if $family == 0 or $family == 2;3369 return(($ex && $$ex{"G$family"}) || $$groups{$family}) if $family == 0 or $family == 2; 2189 3370 $groups[1] = $$groups{1}; 2190 3371 } 2191 3372 } else { 2192 return $$groups{0}unless wantarray;3373 return(($ex && $$ex{G0}) || $$groups{0}) unless wantarray; 2193 3374 foreach (0..2) { $groups[$_] = $$groups{$_}; } 2194 3375 } … … 2196 3377 $groups[4] = ($tag =~ /\((\d+)\)$/) ? "Copy$1" : ''; 2197 3378 # handle dynamic group names if necessary 2198 my $ex = $self->{TAG_EXTRA}{$tag}; 2199 if ($ex and not $byTagInfo) { 2200 $groups[0] = $$ex{G0} if $$ex{G0}; 2201 $groups[1] = $$ex{G1} =~ /^\+(.*)/ ? "$groups[1]$1" : $$ex{G1} if $$ex{G1}; 2202 $groups[3] = 'Doc' . $$ex{G3} if $$ex{G3}; 2203 $groups[5] = $$ex{G5} || $groups[1] if defined $$ex{G5}; 3379 unless ($byTagInfo) { 3380 if ($ex) { 3381 $groups[0] = $$ex{G0} if $$ex{G0}; 3382 $groups[1] = $$ex{G1} =~ /^\+(.*)/ ? "$groups[1]$1" : $$ex{G1} if $$ex{G1}; 3383 $groups[3] = 'Doc' . $$ex{G3} if $$ex{G3}; 3384 $groups[5] = $$ex{G5} || $groups[1] if defined $$ex{G5}; 3385 if (defined $$ex{G6}) { 3386 $groups[5] = '' unless defined $groups[5]; # (can't leave a hole in the array) 3387 $groups[6] = $$ex{G6}; 3388 } 3389 } 3390 # generate tag ID group names unless obviously not needed 3391 unless ($noID) { 3392 my $id = $$tagInfo{TagID}; 3393 if (not defined $id) { 3394 $id = ''; # (just to be safe) 3395 } elsif ($id =~ /^\d+$/) { 3396 $id = sprintf('0x%x', $id) if $$self{OPTIONS}{HexTagIDs}; 3397 } else { 3398 $id =~ s/([^-_A-Za-z0-9])/sprintf('%.2x',ord $1)/ge; 3399 } 3400 $groups[7] = 'ID-' . $id; 3401 defined $groups[$_] or $groups[$_] = '' foreach (5,6); 3402 } 2204 3403 } 2205 3404 if ($family) { 2206 3405 return $groups[$family] || '' if $family > 0; 2207 3406 # add additional matching group names to list 2208 # ie) for MIE-Doc, also add MIE1, MIE1-Doc, MIE-Doc1 and MIE1-Doc13407 # eg) for MIE-Doc, also add MIE1, MIE1-Doc, MIE-Doc1 and MIE1-Doc1 2209 3408 # and for MIE2-Doc3, also add MIE2, MIE-Doc3, MIE2-Doc and MIE-Doc 2210 3409 if ($groups[1] =~ /^MIE(\d*)-(.+?)(\d*)$/) { … … 2219 3418 # create list of group names (without identical adjacent groups if simplifying) 2220 3419 foreach (@families) { 2221 my $grp = $groups[$_] or next; 3420 my $grp = $groups[$_]; 3421 unless ($grp) { 3422 next if $simplify; 3423 $grp = ''; 3424 } 2222 3425 push @grps, $grp unless $simplify and @grps and $grp eq $grps[-1]; 2223 3426 } … … 2246 3449 if (ref $info ne 'HASH') { 2247 3450 $family = $info; 2248 $info = $ self->{VALUE};3451 $info = $$self{VALUE}; 2249 3452 } else { 2250 3453 $family = shift; … … 2264 3467 # Inputs: 0) ExifTool object reference, 2265 3468 # 1-N) group names (reset to default if no groups specified) 3469 # - used when new tag values are set (ie. before files are written) 2266 3470 sub SetNewGroups($;@) 2267 3471 { … … 2269 3473 my ($self, @groups) = @_; 2270 3474 @groups or @groups = @defaultWriteGroups; 2271 my $count = @groups ;3475 my $count = @groups * 10; 2272 3476 my %priority; 2273 3477 foreach (@groups) { 2274 $priority{lc($_)} = $count--; 2275 } 2276 $priority{file} = 10; # 'File' group is always written (Comment) 2277 $priority{composite} = 10; # 'Composite' group is always written 3478 $priority{lc($_)} = $count; 3479 $count -= 10; 3480 } 3481 $priority{file} = 500; # 'File' group is always written (Comment) 3482 $priority{composite} = 500; # 'Composite' group is always written 2278 3483 # set write priority (higher # is higher priority) 2279 $ self->{WRITE_PRIORITY} = \%priority;2280 $ self->{WRITE_GROUPS} = \@groups;3484 $$self{WRITE_PRIORITY} = \%priority; 3485 $$self{WRITE_GROUPS} = \@groups; 2281 3486 } 2282 3487 … … 2293 3498 2294 3499 $$self{BuildingComposite} = 1; 2295 # first, add user-defined Composite tags if necessary 2296 if (%UserDefined and $UserDefined{'Image::ExifTool::Composite'}) { 2297 AddCompositeTags($UserDefined{'Image::ExifTool::Composite'}, 1); 2298 delete $UserDefined{'Image::ExifTool::Composite'}; 2299 } 2300 my @tagList = sort keys %Image::ExifTool::Composite; 2301 my %tagsUsed; 2302 2303 my $rawValue = $self->{VALUE}; 3500 3501 my $compTable = GetTagTable('Image::ExifTool::Composite'); 3502 my @tagList = sort keys %$compTable; 3503 my $rawValue = $$self{VALUE}; 3504 my $compKeys = $$self{COMP_KEYS}; 3505 my (%cache, $allBuilt); 3506 2304 3507 for (;;) { 2305 my %notBuilt;2306 $notBuilt{$_} = 1 foreach @tagList;2307 my @deferredTags;2308 my $tag;3508 my (%notBuilt, $tag, @deferredTags); 3509 foreach (@tagList) { 3510 $notBuilt{$$compTable{$_}{Name}} = 1 unless $specialTags{$_}; 3511 } 2309 3512 COMPOSITE_TAG: 2310 3513 foreach $tag (@tagList) { 2311 3514 next if $specialTags{$tag}; 2312 my $tagInfo = $self->GetTagInfo( \%Image::ExifTool::Composite, $tag);3515 my $tagInfo = $self->GetTagInfo($compTable, $tag); 2313 3516 next unless $tagInfo; 3517 my $tagName = $$compTable{$tag}{Name}; 2314 3518 # put required tags into array and make sure they all exist 2315 3519 my $subDoc = ($$tagInfo{SubDoc} and $$self{DOC_COUNT}); 2316 3520 my $require = $$tagInfo{Require} || { }; 2317 my $desire = $$tagInfo{Desire} || { }; 3521 my $desire = $$tagInfo{Desire} || { }; 3522 my $inhibit = $$tagInfo{Inhibit} || { }; 2318 3523 # loop through sub-documents if necessary 2319 my $doc ;3524 my $docNum = 0; 2320 3525 for (;;) { 2321 3526 my (%tagKey, $found, $index); 2322 3527 # save Require'd and Desire'd tag values in list 2323 3528 for ($index=0; ; ++$index) { 2324 my $reqTag = $$require{$index} || $$desire{$index} or last;2325 # add family 3 group if generating Composite tags for sub-documents2326 # (unless tag already begins with family 3 group name)2327 if ($subDoc and $reqTag !~ /^(Main|Doc\d+):/) {2328 $reqTag = ($doc ? "Doc$doc:" : 'Main:') . $reqTag;3529 my $reqTag = $$require{$index} || $$desire{$index} || $$inhibit{$index}; 3530 unless ($reqTag) { 3531 # allow Composite with no Require'd or Desire'd tags 3532 $found = 1 if $index == 0; 3533 last; 2329 3534 } 2330 # allow tag group to be specified 2331 if ($reqTag =~ /^(.*):(.+)/) { 3535 if ($subDoc) { 3536 # handle SubDoc tags specially to cache tag keys for faster 3537 # processing when there are a large number of sub-documents 3538 # - get document number from the tag groups if specified, 3539 # otherwise we are looping through all documents for this tag 3540 my $doc = $reqTag =~ s/\b(Main|Doc(\d+)):// ? ($2 || 0) : $docNum; 3541 # make fast lookup for keys of this tag with specified groups other than doc group 3542 # (similar to code in InsertTagValues(), but this is case-sensitive) 3543 my $cacheTag = $cache{$reqTag}; 3544 unless ($cacheTag) { 3545 $cacheTag = $cache{$reqTag} = [ ]; 3546 my $reqGroup; 3547 $reqTag =~ s/^(.*):// and $reqGroup = $1; 3548 my ($i, $key, @keys); 3549 # build list of tag keys in order of precedence 3550 for ($key=$reqTag, $i=$$self{DUPL_TAG}{$reqTag} || 0; ; --$i) { 3551 push @keys, $key if defined $$rawValue{$key}; 3552 last if $i <= 0; 3553 $key = "$reqTag ($i)"; 3554 } 3555 @keys = $self->GroupMatches($reqGroup, \@keys) if defined $reqGroup; 3556 if (@keys) { 3557 my $ex = $$self{TAG_EXTRA}; 3558 # loop through tags in reverse order of precedence so the higher 3559 # priority tag will win in the case of duplicates within a doc 3560 $$cacheTag[$$ex{$_} ? $$ex{$_}{G3} || 0 : 0] = $_ foreach reverse @keys; 3561 } 3562 } 3563 # (set $reqTag to a bogus key if not found) 3564 $reqTag = $$cacheTag[$doc] || "$reqTag (0)"; 3565 } elsif ($reqTag =~ /^(.*):(.+)/) { 2332 3566 my ($reqGroup, $name) = ($1, $2); 2333 3567 if ($reqGroup eq 'Composite' and $notBuilt{$name}) { 2334 push @deferredTags, $tag; 2335 next COMPOSITE_TAG; 3568 # defer only until all other tags are built if 3569 # we are inhibiting based on another Composite tag 3570 unless ($$inhibit{$index} and $allBuilt) { 3571 push @deferredTags, $tag; 3572 next COMPOSITE_TAG; 3573 } 2336 3574 } 3575 # (CAREFUL! keys may not be sequential if one was deleted) 2337 3576 my ($i, $key, @keys); 2338 for ($i=0; ; ++$i) { 2339 $key = $name; 2340 $key .= " ($i)" if $i; 2341 last unless defined $$rawValue{$key}; 2342 push @keys, $key; 3577 for ($key=$name, $i=$$self{DUPL_TAG}{$name} || 0; ; --$i) { 3578 push @keys, $key if defined $$rawValue{$key}; 3579 last if $i <= 0; 3580 $key = "$name ($i)"; 2343 3581 } 2344 3582 # find first matching tag 2345 3583 $key = $self->GroupMatches($reqGroup, \@keys); 2346 $reqTag = $key if $key;2347 } elsif ($notBuilt{$reqTag} ) {3584 $reqTag = $key || "$name (0)"; 3585 } elsif ($notBuilt{$reqTag} and not $$inhibit{$index}) { 2348 3586 # calculate this tag later if it relies on another 2349 3587 # Composite tag which hasn't been calculated yet … … 2352 3590 } 2353 3591 if (defined $$rawValue{$reqTag}) { 2354 $found = 1; 3592 if ($$inhibit{$index}) { 3593 $found = 0; 3594 last; 3595 } else { 3596 $found = 1; 3597 } 2355 3598 } elsif ($$require{$index}) { 2356 3599 $found = 0; … … 2359 3602 $tagKey{$index} = $reqTag; 2360 3603 } 2361 if ($doc ) {3604 if ($docNum) { 2362 3605 if ($found) { 2363 $self->{DOC_NUM} = $doc; 3606 $$self{DOC_NUM} = $docNum; 3607 # save pointers to all used tag keys 3608 foreach (keys %tagKey) { 3609 $$compKeys{$_} or $$compKeys{$_} = [ ]; 3610 push @{$$compKeys{$tagKey{$_}}}, [ \%tagKey, $_ ]; 3611 } 2364 3612 $self->FoundTag($tagInfo, \%tagKey); 2365 delete $ self->{DOC_NUM};3613 delete $$self{DOC_NUM}; 2366 3614 } 2367 next if ++$doc <= $self->{DOC_COUNT};3615 next if ++$docNum <= $$self{DOC_COUNT}; 2368 3616 last; 2369 3617 } elsif ($found) { 2370 delete $notBuilt{$tag }; # this tag is OK to build now3618 delete $notBuilt{$tagName}; # this tag is OK to build now 2371 3619 # keep track of all Require'd tag keys 2372 3620 foreach (keys %tagKey) { … … 2374 3622 # can be replaced (also eliminates keys with 2375 3623 # instance numbers which can't be replaced either) 2376 next unless $Image::ExifTool::Composite{$tagKey{$_}}; 2377 my $keyRef = \$tagKey{$_}; 2378 $tagsUsed{$$keyRef} or $tagsUsed{$$keyRef} = [ ]; 2379 push @{$tagsUsed{$$keyRef}}, $keyRef; 3624 next unless $compositeID{$tagKey{$_}}; 3625 } 3626 # save pointers to all used tag keys 3627 foreach (keys %tagKey) { 3628 $$compKeys{$_} or $$compKeys{$_} = [ ]; 3629 push @{$$compKeys{$tagKey{$_}}}, [ \%tagKey, $_ ]; 2380 3630 } 2381 3631 # save reference to tag key lookup as value for Composite tag 2382 3632 my $key = $self->FoundTag($tagInfo, \%tagKey); 2383 # check to see if we just replaced one of the tag keys we Require'd 2384 if (defined $key and $tagsUsed{$key}) { 2385 foreach (@{$tagsUsed{$key}}) { 2386 $$_ = $self->{MOVED_KEY}; # replace with new tag key 2387 } 2388 delete $tagsUsed{$key}; # can't be replaced again 3633 } elsif (not defined $found) { 3634 delete $notBuilt{$tagName}; # tag can't be built anyway 3635 } 3636 last unless $subDoc; 3637 # don't process sub-documents if there is no chance to build this tag 3638 # (can be very time-consuming if there are many docs) 3639 if (%$require) { 3640 foreach (keys %$require) { 3641 my $reqTag = $$require{$_}; 3642 $reqTag =~ s/.*://; 3643 next COMPOSITE_TAG unless defined $$rawValue{$reqTag}; 2389 3644 } 2390 } elsif (not defined $found) { 2391 delete $notBuilt{$tag}; # tag can't be built anyway 2392 } 2393 last unless $subDoc; 2394 $doc = 1; # continue to process the 1st sub-document 3645 $docNum = 1; # go ahead and process the 1st sub-document 3646 } else { 3647 my @try = ref $$tagInfo{SubDoc} ? @{$$tagInfo{SubDoc}} : keys %$desire; 3648 # at least one of the specified desire tags must exist 3649 foreach (@try) { 3650 my $desTag = $$desire{$_} or next; 3651 $desTag =~ s/.*://; 3652 defined $$rawValue{$desTag} and $docNum = 1, last; 3653 } 3654 last unless $docNum; 3655 } 2395 3656 } 2396 3657 } 2397 3658 last unless @deferredTags; 2398 3659 if (@deferredTags == @tagList) { 2399 # everything was deferred in the last pass, 2400 # must be a circular dependency 2401 warn "Circular dependency in Composite tags\n"; 2402 last; 3660 if ($allBuilt) { 3661 # everything was deferred in the last pass, 3662 # must be a circular dependency 3663 warn "Circular dependency in Composite tags\n"; 3664 last; 3665 } 3666 $allBuilt = 1; # try once more, ignoring Composite Inhibit tags 2403 3667 } 2404 3668 @tagList = @deferredTags; # calculate deferred tags now 2405 3669 } 2406 3670 delete $$self{BuildingComposite}; 3671 } 3672 3673 #------------------------------------------------------------------------------ 3674 # Get reference to Composite tag info hash 3675 # Inputs: 0) case-sensitive Composite tag name 3676 # Returns: tagInfo hash or undef 3677 sub GetCompositeTagInfo($) 3678 { 3679 my $tag = shift; 3680 return undef unless $compositeID{$tag}; 3681 return $Image::ExifTool::Composite{$compositeID{$tag}[0]}; 2407 3682 } 2408 3683 … … 2434 3709 # 1) flag to return long description instead of type ('0' to return any recognized type) 2435 3710 # Returns: File type (or desc) or undef if extension not supported or if 2436 # description is the same as the input FileType. In array 2437 # context, may return more than one file type if the file may be 2438 # different formats. Returns list of all supported extensions if no 2439 # file specified 3711 # description is the same as the input FileType. In list context, 3712 # may return more than one file type if the file may be different formats. 3713 # Returns list of all supported extensions if no file specified 2440 3714 sub GetFileType(;$$) 2441 3715 { … … 2450 3724 # return all supported types 2451 3725 foreach (sort keys %fileTypeLookup) { 2452 push @types, $_ unless defined $moduleName{$_} and $moduleName{$_} eq '0'; 3726 my $module = $moduleName{$_}; 3727 $module = $moduleName{$fileTypeLookup{$_}} unless defined $module; 3728 push @types, $_ unless defined $module and $module eq '0'; 2453 3729 } 2454 3730 } 2455 3731 return @types; 2456 3732 } 2457 my $fileType;3733 my ($fileType, $subType); 2458 3734 my $fileExt = GetFileExtension($file); 2459 $fileExt = uc($file) unless $fileExt; 3735 unless ($fileExt) { 3736 if ($file =~ s/ \((.*)\)$//) { 3737 $subType = $1; 3738 $fileExt = GetFileExtension($file); 3739 } 3740 $fileExt = uc($file) unless $fileExt; 3741 } 2460 3742 $fileExt and $fileType = $fileTypeLookup{$fileExt}; # look up the file type 2461 $fileType = $fileTypeLookup{$fileType} unless ref $fileType or not$fileType;3743 $fileType = $fileTypeLookup{$fileType} while $fileType and not ref $fileType; 2462 3744 # return description if specified 2463 3745 # (allow input $file to be a FileType for this purpose) 2464 3746 if ($desc) { 2465 return $fileType ? $$fileType[1] : $fileDescription{$file}; 3747 $desc = $fileType ? $$fileType[1] : $fileDescription{$file}; 3748 $desc .= ", $subType" if $subType; 3749 return $desc; 2466 3750 } elsif ($fileType and (not defined $desc or $desc ne '0')) { 2467 3751 # return only supported file types … … 2469 3753 undef $fileType if defined $mod and $mod eq '0'; 2470 3754 } 2471 $fileType or return wantarray ? () : undef;3755 $fileType or return (); 2472 3756 $fileType = $$fileType[0]; # get file type (or list of types) 2473 3757 if (wantarray) { … … 2487 3771 local $_; 2488 3772 my $file = shift or return undef; 2489 my $type= GetFileType($file) or return undef;3773 my ($type) = GetFileType($file) or return undef; 2490 3774 if ($noWriteFile{$type}) { 2491 3775 # can't write TIFF files with certain extensions (various RAW formats) … … 2493 3777 return grep(/^$ext$/, @{$noWriteFile{$type}}) ? 0 : 1 if $ext; 2494 3778 } 2495 return scalar(grep /^$type$/, @writeTypes); 3779 unless (%writeTypes) { 3780 $writeTypes{$_} = 1 foreach @writeTypes; 3781 } 3782 return $writeTypes{$type}; 2496 3783 } 2497 3784 … … 2513 3800 # Functions below this are not part of the public API 2514 3801 2515 # Initialize member variables 3802 # Initialize member variables for reading or writing a new file 2516 3803 # Inputs: 0) ExifTool object reference 2517 3804 sub Init($) … … 2521 3808 # delete all DataMember variables (lower-case names) 2522 3809 foreach (keys %$self) { 2523 /[a-z]/ and delete $self->{$_}; 2524 } 2525 delete $self->{FOUND_TAGS}; # list of found tags 2526 delete $self->{EXIF_DATA}; # the EXIF data block 2527 delete $self->{EXIF_POS}; # EXIF position in file 2528 delete $self->{FIRST_EXIF_POS}; # position of first EXIF in file 2529 delete $self->{HTML_DUMP}; # html dump information 2530 delete $self->{SET_GROUP1}; # group1 name override 2531 delete $self->{DOC_NUM}; # current embedded document number 2532 $self->{DOC_COUNT} = 0; # count of embedded documents processed 2533 $self->{BASE} = 0; # base for offsets from start of file 2534 $self->{FILE_ORDER} = { }; # * hash of tag order in file 2535 $self->{VALUE} = { }; # * hash of raw tag values 2536 $self->{BOTH} = { }; # * hash for Value/PrintConv values of Require'd tags 2537 $self->{TAG_INFO} = { }; # * hash of tag information 2538 $self->{TAG_EXTRA} = { }; # * hash of extra tag information (dynamic group names) 2539 $self->{PRIORITY} = { }; # * priority of current tags 2540 $self->{LIST_TAGS} = { }; # hash of tagInfo refs for active List-type tags 2541 $self->{PROCESSED} = { }; # hash of processed directory start positions 2542 $self->{DIR_COUNT} = { }; # count various types of directories 2543 $self->{DUPL_TAG} = { }; # last-used index for duplicate-tag keys 2544 $self->{WARNED_ONCE}= { }; # WarnOnce() warnings already issued 2545 $self->{PATH} = [ ]; # current subdirectory path in file when reading 2546 $self->{NUM_FOUND} = 0; # total number of tags found (incl. duplicates) 2547 $self->{CHANGED} = 0; # number of tags changed (writer only) 2548 $self->{INDENT} = ' '; # initial indent for verbose messages 2549 $self->{PRIORITY_DIR} = ''; # the priority directory name 2550 $self->{LOW_PRIORITY_DIR} = { PreviewIFD => 1 }; # names of priority 0 directories 2551 $self->{TIFF_TYPE} = ''; # type of TIFF data (APP1, TIFF, NEF, etc...) 2552 $self->{Make} = ''; # camera make 2553 $self->{Model} = ''; # camera model 2554 $self->{CameraType} = ''; # Olympus camera type 3810 /[a-z]/ and delete $$self{$_}; 3811 } 3812 delete $$self{FOUND_TAGS}; # list of found tags 3813 delete $$self{EXIF_DATA}; # the EXIF data block 3814 delete $$self{EXIF_POS}; # EXIF position in file 3815 delete $$self{FIRST_EXIF_POS}; # position of first EXIF in file 3816 delete $$self{HTML_DUMP}; # html dump information 3817 delete $$self{SET_GROUP0}; # group0 name override 3818 delete $$self{SET_GROUP1}; # group1 name override 3819 delete $$self{DOC_NUM}; # current embedded document number 3820 $$self{DOC_COUNT} = 0; # count of embedded documents processed 3821 $$self{BASE} = 0; # base for offsets from start of file 3822 $$self{FILE_ORDER} = { }; # * hash of tag order in file ('*' = based on tag key) 3823 $$self{VALUE} = { }; # * hash of raw tag values 3824 $$self{BOTH} = { }; # * hash for Value/PrintConv values of Require'd tags 3825 $$self{RATIONAL} = { }; # * hash of original rational components 3826 $$self{TAG_INFO} = { }; # * hash of tag information 3827 $$self{TAG_EXTRA} = { }; # * hash of extra tag information (dynamic group names) 3828 $$self{PRIORITY} = { }; # * priority of current tags 3829 $$self{LIST_TAGS} = { }; # hash of tagInfo refs for active List-type tags 3830 $$self{PROCESSED} = { }; # hash of processed directory start positions 3831 $$self{DIR_COUNT} = { }; # count various types of directories 3832 $$self{DUPL_TAG} = { }; # last-used index for duplicate-tag keys 3833 $$self{WARNED_ONCE}= { }; # WarnOnce() warnings already issued 3834 $$self{WRITTEN} = { }; # list of tags written (selected tags only) 3835 $$self{FORCE_WRITE}= { }; # ForceWrite lookup (set from ForceWrite tag) 3836 $$self{FOUND_DIR} = { }; # hash of directory names found in file 3837 $$self{COMP_KEYS} = { }; # lookup for tag keys used in Composite tags 3838 $$self{PATH} = [ ]; # current subdirectory path in file when reading 3839 $$self{NUM_FOUND} = 0; # total number of tags found (incl. duplicates) 3840 $$self{CHANGED} = 0; # number of tags changed (writer only) 3841 $$self{INDENT} = ' '; # initial indent for verbose messages 3842 $$self{PRIORITY_DIR} = ''; # the priority directory name 3843 $$self{LOW_PRIORITY_DIR} = { PreviewIFD => 1 }; # names of priority 0 directories 3844 $$self{TIFF_TYPE} = ''; # type of TIFF data (APP1, TIFF, NEF, etc...) 3845 $$self{FMT_EXPR} = undef; # current advanced formatting expression 3846 $$self{Make} = ''; # camera make 3847 $$self{Model} = ''; # camera model 3848 $$self{CameraType} = ''; # Olympus camera type 3849 $$self{FileType} = ''; # identified file type 2555 3850 if ($self->Options('HtmlDump')) { 2556 3851 require Image::ExifTool::HtmlDump; 2557 $ self->{HTML_DUMP} = new Image::ExifTool::HtmlDump;3852 $$self{HTML_DUMP} = new Image::ExifTool::HtmlDump; 2558 3853 } 2559 3854 # make sure our TextOut is a file reference 2560 $self->{OPTIONS}{TextOut} = \*STDOUT unless ref $self->{OPTIONS}{TextOut}; 3855 $$self{OPTIONS}{TextOut} = \*STDOUT unless ref $$self{OPTIONS}{TextOut}; 3856 } 3857 3858 #------------------------------------------------------------------------------ 3859 # Combine information from a list of info hashes 3860 # Unless Duplicates is enabled, first entry found takes priority 3861 # Inputs: 0) ExifTool object reference, 1-N) list of info hash references 3862 # Returns: Combined information hash reference 3863 sub CombineInfo($;@) 3864 { 3865 local $_; 3866 my $self = shift; 3867 my (%combinedInfo, $info, $tag, %haveInfo); 3868 3869 if ($$self{OPTIONS}{Duplicates}) { 3870 while ($info = shift) { 3871 foreach $tag (keys %$info) { 3872 $combinedInfo{$tag} = $$info{$tag}; 3873 } 3874 } 3875 } else { 3876 while ($info = shift) { 3877 foreach $tag (keys %$info) { 3878 my $tagName = GetTagName($tag); 3879 next if $haveInfo{$tagName}; 3880 $haveInfo{$tagName} = 1; 3881 $combinedInfo{$tag} = $$info{$tag}; 3882 } 3883 } 3884 } 3885 return \%combinedInfo; 3886 } 3887 3888 #------------------------------------------------------------------------------ 3889 # Get tag table name 3890 # Inputs: 0) ExifTool object reference, 1) tag key 3891 # Returns: Table name if available, otherwise '' 3892 sub GetTableName($$) 3893 { 3894 my ($self, $tag) = @_; 3895 my $tagInfo = $$self{TAG_INFO}{$tag} or return ''; 3896 return $$tagInfo{Table}{SHORT_NAME}; 3897 } 3898 3899 #------------------------------------------------------------------------------ 3900 # Get tag index number 3901 # Inputs: 0) ExifTool object reference, 1) tag key 3902 # Returns: Table index number, or undefined if this tag isn't indexed 3903 sub GetTagIndex($$) 3904 { 3905 my ($self, $tag) = @_; 3906 my $tagInfo = $$self{TAG_INFO}{$tag} or return undef; 3907 return $$tagInfo{Index}; 3908 } 3909 3910 #------------------------------------------------------------------------------ 3911 # Find value for specified tag 3912 # Inputs: 0) ExifTool ref, 1) tag name, 2) tag group (family 1) 3913 # Returns: value or undef 3914 sub FindValue($$$) 3915 { 3916 my ($et, $tag, $grp) = @_; 3917 my ($i, $val); 3918 my $value = $$et{VALUE}; 3919 for ($i=0; ; ++$i) { 3920 my $key = $tag . ($i ? " ($i)" : ''); 3921 last unless defined $$value{$key}; 3922 if ($et->GetGroup($key, 1) eq $grp) { 3923 $val = $$value{$key}; 3924 last; 3925 } 3926 } 3927 return $val; 3928 } 3929 3930 #------------------------------------------------------------------------------ 3931 # Get tag key for next existing tag 3932 # Inputs: 0) ExifTool ref, 1) tag key or case-sensitive tag name 3933 # Returns: Key of next existing tag, or undef if no more 3934 # Notes: This routine is provided for iterating through duplicate tags in the 3935 # ValueConv of Composite tags. 3936 sub NextTagKey($$) 3937 { 3938 my ($self, $tag) = @_; 3939 my $i = ($tag =~ s/ \((\d+)\)$//) ? $1 + 1 : 1; 3940 $tag = "$tag ($i)"; 3941 return $tag if defined $$self{VALUE}{$tag}; 3942 return undef; 3943 } 3944 3945 #------------------------------------------------------------------------------ 3946 # Split file name into directory and name parts 3947 # Inptus: 0) file name 3948 # Returns: 0) directory, 1) filename 3949 sub SplitFileName($) 3950 { 3951 my $file = shift; 3952 my ($dir, $name); 3953 if (eval { require File::Basename }) { 3954 $dir = File::Basename::dirname($file); 3955 $name = File::Basename::basename($file); 3956 } else { 3957 ($name = $file) =~ tr/\\/\//; 3958 # remove path 3959 $dir = length($1) ? $1 : '/' if $name =~ s/(.*)\///; 3960 } 3961 return ($dir, $name); 3962 } 3963 3964 #------------------------------------------------------------------------------ 3965 # Encode file name for calls to system i/o routines 3966 # Inputs: 0) ExifTool ref, 1) file name in CharSetFileName, 2) flag to force conversion 3967 # Returns: true if Windows Unicode routines should be used (in which case 3968 # the file name will be encoded as a null-terminated UTF-16LE string) 3969 sub EncodeFileName($$;$) 3970 { 3971 my ($self, $file, $force) = @_; 3972 my $enc = $$self{OPTIONS}{CharsetFileName}; 3973 if ($enc) { 3974 if ($file =~ /[\x80-\xff]/ or $force) { 3975 # encode for use in Windows Unicode functions if necessary 3976 if ($^O eq 'MSWin32') { 3977 local $SIG{'__WARN__'} = \&SetWarning; 3978 if (eval { require Win32API::File }) { 3979 # recode as UTF-16LE and add null terminator 3980 $_[1] = $self->Decode($file, $enc, undef, 'UTF16', 'II') . "\0\0"; 3981 return 1; 3982 } 3983 $self->WarnOnce('Install Win32API::File for Windows Unicode file support'); 3984 } else { 3985 # recode as UTF-8 for other platforms if necessary 3986 $_[1] = $self->Decode($file, $enc, undef, 'UTF8') unless $enc eq 'UTF8'; 3987 } 3988 } 3989 } elsif ($^O eq 'MSWin32' and $file =~ /[\x80-\xff]/ and not defined $enc) { 3990 require Image::ExifTool::XMP; 3991 if (Image::ExifTool::XMP::IsUTF8(\$file) < 0) { 3992 $self->WarnOnce('FileName encoding not specified'); 3993 } 3994 } 3995 return 0; 3996 } 3997 3998 #------------------------------------------------------------------------------ 3999 # Modified perl open() routine to properly handle special characters in file names 4000 # Inputs: 0) ExifTool ref, 1) filehandle, 2) filename, 4001 # 3) mode: '<' or undef = read, '>' = write, '+<' = update 4002 # Returns: true on success 4003 # Note: Must call like "$et->Open(\*FH,$file)", not "$et->Open(FH,$file)" to avoid 4004 # "unopened filehandle" errors due to a change in scope of the filehandle 4005 sub Open($*$;$) 4006 { 4007 my ($self, $fh, $file, $mode) = @_; 4008 4009 $file =~ s/^([\s&])/.\/$1/; # protect leading whitespace or ampersand 4010 # default to read mode ('<') unless input is a pipe 4011 $mode = ($file =~ /\|$/ ? '' : '<') unless $mode; 4012 if ($mode) { 4013 if ($self->EncodeFileName($file)) { 4014 # handle Windows Unicode file name 4015 local $SIG{'__WARN__'} = \&SetWarning; 4016 my ($access, $create); 4017 if ($mode eq '>') { 4018 eval { 4019 $access = Win32API::File::GENERIC_WRITE(); 4020 $create = Win32API::File::CREATE_ALWAYS(); 4021 } 4022 } else { 4023 eval { 4024 $access = Win32API::File::GENERIC_READ(); 4025 $access |= Win32API::File::GENERIC_WRITE() if $mode eq '+<'; # update 4026 $create = Win32API::File::OPEN_EXISTING(); 4027 } 4028 } 4029 my $share = 0; 4030 eval { 4031 unless ($access & Win32API::File::GENERIC_WRITE()) { 4032 $share = Win32API::File::FILE_SHARE_READ() | Win32API::File::FILE_SHARE_WRITE(); 4033 } 4034 }; 4035 my $wh = eval { Win32API::File::CreateFileW($file, $access, $share, [], $create, 0, []) }; 4036 return undef unless $wh; 4037 my $fd = eval { Win32API::File::OsFHandleOpenFd($wh, 0) }; 4038 if (not defined $fd or $fd < 0) { 4039 eval { Win32API::File::CloseHandle($wh) }; 4040 return undef; 4041 } 4042 $file = "&=$fd"; # specify file by descriptor 4043 } else { 4044 # add leading space to protect against leading characters like '>' 4045 # in file name, and trailing "\0" to protect trailing spaces 4046 $file = " $file\0"; 4047 } 4048 } 4049 return open $fh, "$mode$file"; 4050 } 4051 4052 #------------------------------------------------------------------------------ 4053 # Check to see if a file exists (with Windows Unicode support) 4054 # Inputs: 0) ExifTool ref, 1) file name 4055 # Returns: true if file exists 4056 sub Exists($$) 4057 { 4058 my ($self, $file) = @_; 4059 4060 if ($self->EncodeFileName($file)) { 4061 local $SIG{'__WARN__'} = \&SetWarning; 4062 my $wh = eval { Win32API::File::CreateFileW($file, 4063 Win32API::File::GENERIC_READ(), 4064 Win32API::File::FILE_SHARE_READ(), [], 4065 Win32API::File::OPEN_EXISTING(), 0, []) }; 4066 return 0 unless $wh; 4067 eval { Win32API::File::CloseHandle($wh) }; 4068 } else { 4069 return -e $file; 4070 } 4071 return 1; 4072 } 4073 4074 #------------------------------------------------------------------------------ 4075 # Return true if file is a directory (with Windows Unicode support) 4076 # Inputs: 0) ExifTool ref, 1) file name 4077 # Returns: true if file is a directory (false if file isn't, or doesn't exist) 4078 sub IsDirectory($$) 4079 { 4080 my ($et, $file) = @_; 4081 if ($et->EncodeFileName($file)) { 4082 local $SIG{'__WARN__'} = \&SetWarning; 4083 my $attrs = eval { Win32API::File::GetFileAttributesW($file) }; 4084 my $dirBit = eval { Win32API::File::FILE_ATTRIBUTE_DIRECTORY() } || 0; 4085 return 1 if $attrs and $attrs != 0xffffffff and $attrs & $dirBit; 4086 } else { 4087 return -d $file; 4088 } 4089 return 0; 4090 } 4091 4092 #------------------------------------------------------------------------------ 4093 # Get file times (Unix seconds since the epoch) 4094 # Inputs: 0) ExifTool ref, 1) file name or ref 4095 # Returns: 0) access time, 1) modification time, 2) creation time (or undefs on error) 4096 my $k32GetFileTime; 4097 sub GetFileTime($$) 4098 { 4099 my ($self, $file) = @_; 4100 4101 # open file by name if necessary 4102 unless (ref $file) { 4103 local *FH; 4104 unless ($self->Open(\*FH, $file)) { 4105 if ($self->IsDirectory($file)) { 4106 my @rtn = (stat $file)[8, 9, 10]; 4107 return @rtn if defined $rtn[0]; 4108 } 4109 $self->Warn("GetFileTime error for '${file}'"); 4110 return (); 4111 } 4112 $file = *FH; # (not \*FH, so *FH will be kept open until $file goes out of scope) 4113 } 4114 # on Windows, try to work around incorrect file times when daylight saving time is in effect 4115 if ($^O eq 'MSWin32') { 4116 if (not eval { require Win32::API }) { 4117 $self->WarnOnce('Install Win32::API for proper handling of Windows file times'); 4118 } elsif (not eval { require Win32API::File }) { 4119 $self->WarnOnce('Install Win32API::File for proper handling of Windows file times'); 4120 } else { 4121 # get Win32 handle, needed for GetFileTime 4122 my $win32Handle = eval { Win32API::File::GetOsFHandle($file) }; 4123 unless ($win32Handle) { 4124 $self->Warn("Win32API::File::GetOsFHandle returned invalid handle"); 4125 return (); 4126 } 4127 # get FILETIME structs 4128 my ($atime, $mtime, $ctime, $time); 4129 $atime = $mtime = $ctime = pack 'LL', 0, 0; 4130 unless ($k32GetFileTime) { 4131 return () if defined $k32GetFileTime; 4132 $k32GetFileTime = new Win32::API('KERNEL32', 'GetFileTime', 'NPPP', 'I'); 4133 unless ($k32GetFileTime) { 4134 $self->Warn('Error calling Win32::API::GetFileTime'); 4135 $k32GetFileTime = 0; 4136 return (); 4137 } 4138 } 4139 unless ($k32GetFileTime->Call($win32Handle, $ctime, $atime, $mtime)) { 4140 $self->Warn("Win32::API::GetFileTime returned " . Win32::GetLastError()); 4141 return (); 4142 } 4143 # convert FILETIME structs to Unix seconds 4144 foreach $time ($atime, $mtime, $ctime) { 4145 my ($lo, $hi) = unpack 'LL', $time; # unpack FILETIME struct 4146 # FILETIME is in 100 ns intervals since 0:00 UTC Jan 1, 1601 4147 # (89 leap years between 1601 and 1970) 4148 $time = ($hi * 4294967296 + $lo) * 1e-7 - (((1970-1601)*365+89)*24*3600); 4149 } 4150 return ($atime, $mtime, $ctime); 4151 } 4152 } 4153 # other os (or Windows fallback) 4154 return (stat $file)[8, 9, 10]; 2561 4155 } 2562 4156 … … 2568 4162 { 2569 4163 my $self = shift; 2570 my $options = $ self->{OPTIONS};2571 my @ exclude;2572 my @oldGroupOpts = grep /^Group/, keys %{$self->{OPTIONS}};2573 my $wasExcludeOpt; 2574 2575 $ self->{REQUESTED_TAGS} = [ ];2576 $ self->{REQ_TAG_LOOKUP} = { };2577 $ self->{IO_TAG_LIST} = undef;4164 my $options = $$self{OPTIONS}; 4165 my @oldGroupOpts = grep /^Group/, keys %{$$self{OPTIONS}}; 4166 my (@exclude, $wasExcludeOpt); 4167 4168 $$self{REQUESTED_TAGS} = [ ]; 4169 $$self{REQ_TAG_LOOKUP} = { }; 4170 $$self{EXCL_TAG_LOOKUP} = { }; 4171 $$self{IO_TAG_LIST} = undef; 2578 4172 2579 4173 # handle our input arguments 2580 4174 while (@_) { 2581 4175 my $arg = shift; 2582 if (ref $arg ) {4176 if (ref $arg and not overload::Method($arg, q[""])) { 2583 4177 if (ref $arg eq 'ARRAY') { 2584 $ self->{IO_TAG_LIST} = $arg;4178 $$self{IO_TAG_LIST} = $arg; 2585 4179 foreach (@$arg) { 2586 4180 if (/^-(.*)/) { 2587 4181 push @exclude, $1; 2588 4182 } else { 2589 push @{$ self->{REQUESTED_TAGS}}, $_;4183 push @{$$self{REQUESTED_TAGS}}, $_; 2590 4184 } 2591 4185 } … … 2596 4190 if (@oldGroupOpts and $opt =~ /^Group/) { 2597 4191 foreach (@oldGroupOpts) { 2598 delete $ options->{$_};4192 delete $$options{$_}; 2599 4193 } 2600 4194 undef @oldGroupOpts; … … 2604 4198 } 2605 4199 } elsif (ref $arg eq 'SCALAR' or UNIVERSAL::isa($arg,'GLOB')) { 2606 next if defined $ self->{RAF};4200 next if defined $$self{RAF}; 2607 4201 # convert image data from UTF-8 to character stream if necessary 2608 4202 # (patches RHEL 3 UTF8 LANG problem) 2609 4203 if (ref $arg eq 'SCALAR' and $] >= 5.006 and 2610 (eval 'require Encode; Encode::is_utf8($$arg)'or $@))4204 (eval { require Encode; Encode::is_utf8($$arg) } or $@)) 2611 4205 { 2612 4206 # repack by hand if Encode isn't available 2613 my $buff = $@ ? pack('C*',unpack( 'U0C*',$$arg)) : Encode::encode('utf8',$$arg);4207 my $buff = $@ ? pack('C*',unpack($] < 5.010000 ? 'U0C*' : 'C0C*',$$arg)) : Encode::encode('utf8',$$arg); 2614 4208 $arg = \$buff; 2615 4209 } 2616 $ self->{RAF} = new File::RandomAccess($arg);4210 $$self{RAF} = new File::RandomAccess($arg); 2617 4211 # set filename to empty string to indicate that 2618 4212 # we have a file but we didn't open it 2619 $ self->{FILENAME} = '';4213 $$self{FILENAME} = ''; 2620 4214 } elsif (UNIVERSAL::isa($arg, 'File::RandomAccess')) { 2621 $ self->{RAF} = $arg;2622 $ self->{FILENAME} = '';4215 $$self{RAF} = $arg; 4216 $$self{FILENAME} = ''; 2623 4217 } else { 2624 4218 warn "Don't understand ImageInfo argument $arg\n"; 2625 4219 } 2626 } elsif (defined $ self->{FILENAME}) {4220 } elsif (defined $$self{FILENAME}) { 2627 4221 if ($arg =~ /^-(.*)/) { 2628 4222 push @exclude, $1; 2629 4223 } else { 2630 push @{$ self->{REQUESTED_TAGS}}, $arg;4224 push @{$$self{REQUESTED_TAGS}}, $arg; 2631 4225 } 2632 4226 } else { 2633 $self->{FILENAME} = $arg; 2634 } 4227 $$self{FILENAME} = $arg; 4228 } 4229 } 4230 # add additional requested tags to lookup 4231 if ($$options{RequestTags}) { 4232 $$self{REQ_TAG_LOOKUP}{$_} = 1 foreach @{$$options{RequestTags}}; 2635 4233 } 2636 4234 # expand shortcuts in tag arguments if provided 2637 if (@{$ self->{REQUESTED_TAGS}}) {2638 ExpandShortcuts($ self->{REQUESTED_TAGS});4235 if (@{$$self{REQUESTED_TAGS}}) { 4236 ExpandShortcuts($$self{REQUESTED_TAGS}); 2639 4237 # initialize lookup for requested tags 2640 foreach (@{$self->{REQUESTED_TAGS}}) { 2641 $self->{REQ_TAG_LOOKUP}{lc(/.+:(.+)/ ? $1 : $_)} = 1; 2642 } 2643 } 2644 4238 foreach (@{$$self{REQUESTED_TAGS}}) { 4239 /^(.*:)?([-\w?*]*)#?$/ or next; 4240 $$self{REQ_TAG_LOOKUP}{lc($2)} = 1 if $2; 4241 next unless $1; 4242 $$self{REQ_TAG_LOOKUP}{lc($_).':'} = 1 foreach split /:/, $1; 4243 } 4244 } 2645 4245 if (@exclude or $wasExcludeOpt) { 2646 4246 # must add existing excluded tags 2647 if ($options->{Exclude}) { 2648 if (ref $options->{Exclude} eq 'ARRAY') { 2649 push @exclude, @{$options->{Exclude}}; 2650 } else { 2651 push @exclude, $options->{Exclude}; 2652 } 2653 } 2654 $options->{Exclude} = \@exclude; 4247 push @exclude, @{$$options{Exclude}} if $$options{Exclude}; 4248 $$options{Exclude} = \@exclude; 2655 4249 # expand shortcuts in new exclude list 2656 ExpandShortcuts($options->{Exclude}, 1); # (also remove '#' suffix) 2657 } 4250 ExpandShortcuts($$options{Exclude}, 1); # (also remove '#' suffix) 4251 } 4252 # generate lookup for excluded tags 4253 if ($$options{Exclude}) { 4254 foreach (@{$$options{Exclude}}) { 4255 /([-\w]+)#?$/ and $$self{EXCL_TAG_LOOKUP}{lc($1)} = 1; 4256 } 4257 # exclude list is used only for EXCL_TAG_LOOKUP when TAGS_FROM_FILE is set 4258 undef $$options{Exclude} if $$self{TAGS_FROM_FILE}; 4259 } 4260 } 4261 4262 #------------------------------------------------------------------------------ 4263 # Does group name match the tag ID? 4264 # Inputs: 0) tag ID, 1) group name (with "ID-" removed) 4265 # Returns: true on success 4266 sub IsSameID($$) 4267 { 4268 my ($id, $grp) = @_; 4269 return 1 if $grp eq $id; # decimal ID's or raw ID's 4270 if ($id =~ /^\d+$/) { # numerical numerical ID's may be in hex 4271 return 1 if $grp =~ s/^0x0*// and $grp eq sprintf('%x', $id); 4272 } else { # other ID's may conform to ExifTool group name conventions 4273 return 1 if $id =~ s/([^-_A-Za-z0-9])/sprintf('%.2x',ord $1)/ge and $grp eq $id; 4274 } 4275 return 0; 2658 4276 } 2659 4277 … … 2669 4287 $tagList = [ $tagList ] unless ref $tagList; 2670 4288 my ($tag, @matches); 2671 if ($group =~ /:/) { 2672 # check each group name individually (ie. "Author:1IPTC") 2673 my @grps = split ':', lc $group; 2674 my (@fmys, $g); 4289 # check each group name individually (eg. "Author:1IPTC") 4290 my @grps = split ':', $group; 4291 my (@fmys, $g); 4292 for ($g=0; $g<@grps; ++$g) { 4293 if ($grps[$g] =~ s/^(\d*)(id-)?//i) { 4294 $fmys[$g] = $1 if length $1; 4295 if ($2) { 4296 $fmys[$g] = 7; 4297 next; # (don't convert tag ID's to lower case) 4298 } 4299 } 4300 $grps[$g] = lc $grps[$g]; 4301 $grps[$g] = '' if $grps[$g] eq 'copy0'; # accept 'Copy0' for primary tag 4302 } 4303 foreach $tag (@$tagList) { 4304 my @groups = $self->GetGroup($tag, -1); 2675 4305 for ($g=0; $g<@grps; ++$g) { 2676 $fmys[$g] = $1 if $grps[$g] =~ s/^(\d+)//; 2677 } 2678 foreach $tag (@$tagList) { 2679 my @groups = $self->GetGroup($tag, -1); 2680 for ($g=0; $g<@grps; ++$g) { 2681 my $grp = $grps[$g]; 2682 next if $grp eq '*' or $grp eq 'all'; 2683 if (defined $fmys[$g]) { 2684 my $f = $fmys[$g]; 2685 last unless $groups[$f] and $grps[$g] eq lc $groups[$f]; 4306 my $grp = $grps[$g]; 4307 next if $grp eq '*' or $grp eq 'all'; 4308 my $f; 4309 if (defined($f = $fmys[$g])) { 4310 last unless defined $groups[$f]; 4311 if ($f == 7) { 4312 next if IsSameID($self->GetTagID($tag), $grp); 2686 4313 } else { 2687 last unless grep /^$grps[$g]$/i, @groups; 2688 } 2689 } 2690 push @matches, $tag if $g == @grps; 4314 next if $grp eq lc $groups[$f]; 4315 } 4316 last; 4317 } else { 4318 last unless grep /^$grp$/i, @groups; 4319 } 4320 } 4321 if ($g == @grps) { 4322 return $tag unless wantarray; 4323 push @matches, $tag; 4324 } 4325 } 4326 return wantarray ? @matches : $matches[0]; 4327 } 4328 4329 #------------------------------------------------------------------------------ 4330 # Remove specified tags from returned tag list, updating indices in other lists 4331 # Inputs: 0) tag list ref, 1) index list ref, 2) index list ref, 3) hash ref, 4332 # 4) true to include tags from hash instead of excluding 4333 # Returns: nothing, but updates input lists 4334 sub RemoveTagsFromList($$$$;$) 4335 { 4336 local $_; 4337 my ($tags, $list1, $list2, $exclude, $inv) = @_; 4338 my @filteredTags; 4339 4340 if (@$list1 or @$list2) { 4341 while (@$tags) { 4342 my $tag = pop @$tags; 4343 my $i = @$tags; 4344 if ($$exclude{$tag} xor $inv) { 4345 # remove index of excluded tag from each list 4346 @$list1 = map { $_ < $i ? $_ : $_ == $i ? () : $_ - 1 } @$list1; 4347 @$list2 = map { $_ < $i ? $_ : $_ == $i ? () : $_ - 1 } @$list2; 4348 } else { 4349 unshift @filteredTags, $tag; 4350 } 2691 4351 } 2692 4352 } else { 2693 my $family = ($group =~ s/^(\d+)//) ? $1 : -1; 2694 foreach $tag (@$tagList) { 2695 my @groups = $self->GetGroup($tag, $family); 2696 push @matches, $tag if grep(/^$group$/i, @groups); 2697 } 2698 } 2699 return wantarray ? @matches : $matches[0]; 4353 foreach (@$tags) { 4354 push @filteredTags, $_ unless $$exclude{$_} xor $inv; 4355 } 4356 } 4357 $_[0] = \@filteredTags; # update tag list 2700 4358 } 2701 4359 … … 2705 4363 # Returns: 0) Reference to list of found tag keys (in order of requested tags) 2706 4364 # 1) Reference to list of indices for tags requested by value 4365 # 2) Reference to list of indices for tags specified by wildcard or "all" 4366 # Notes: index lists are returned in increasing order 2707 4367 sub SetFoundTags($) 2708 4368 { 2709 4369 my $self = shift; 2710 my $options = $ self->{OPTIONS};2711 my $reqTags = $ self->{REQUESTED_TAGS} || [ ];2712 my $duplicates = $ options->{Duplicates};2713 my $exclude = $ options->{Exclude};2714 my $fileOrder = $ self->{FILE_ORDER};4370 my $options = $$self{OPTIONS}; 4371 my $reqTags = $$self{REQUESTED_TAGS} || [ ]; 4372 my $duplicates = $$options{Duplicates}; 4373 my $exclude = $$options{Exclude}; 4374 my $fileOrder = $$self{FILE_ORDER}; 2715 4375 my @groupOptions = sort grep /^Group/, keys %$options; 2716 4376 my $doDups = $duplicates || $exclude || @groupOptions; 2717 my ($tag, $rtnTags, @byValue );4377 my ($tag, $rtnTags, @byValue, @wildTags); 2718 4378 2719 4379 # only return requested tags if specified … … 2721 4381 $rtnTags or $rtnTags = [ ]; 2722 4382 # scan through the requested tags and generate a list of tags we found 2723 my $tagHash = $ self->{VALUE};4383 my $tagHash = $$self{VALUE}; 2724 4384 my $reqTag; 2725 4385 foreach $reqTag (@$reqTags) { … … 2730 4390 $allGrp = 1; 2731 4391 } elsif ($group !~ /^[-\w:]*$/) { 2732 $self->Warn("Invalid group name '$ group'");4392 $self->Warn("Invalid group name '${group}'"); 2733 4393 $group = 'invalid'; 2734 4394 } … … 2736 4396 $tag = $reqTag; 2737 4397 } 2738 $byValue = 1 if $tag =~ s/#$// ;2739 if (defined $ tagHash->{$reqTag} and not $doDups) {4398 $byValue = 1 if $tag =~ s/#$// and $$options{PrintConv}; 4399 if (defined $$tagHash{$reqTag} and not $doDups) { 2740 4400 $matches[0] = $tag; 2741 4401 } elsif ($tag =~ /^(\*|all)$/i) { 2742 4402 # tag name of '*' or 'all' matches all tags 2743 4403 if ($doDups or $allGrp) { 2744 @matches = keys %$tagHash;4404 @matches = grep(!/#/, keys %$tagHash); 2745 4405 } else { 2746 4406 @matches = grep(!/ /, keys %$tagHash); … … 2752 4412 $tag =~ s/\*/[-\\w]*/g; 2753 4413 $tag =~ s/\?/[-\\w]/g; 2754 $tag .= '( .*)?' if $doDups or $allGrp;4414 $tag .= '( \\(.*)?' if $doDups or $allGrp; 2755 4415 @matches = grep(/^$tag$/i, keys %$tagHash); 2756 4416 next unless @matches; # don't want entry in list for wildcard tags … … 2758 4418 } elsif ($doDups or defined $group) { 2759 4419 # must also look for tags like "Tag (1)" 2760 @matches = grep(/^$tag( |$)/i, keys %$tagHash); 4420 # (but be sure not to match temporary ValueConv entries like "Tag #") 4421 @matches = grep(/^$tag( \(|$)/i, keys %$tagHash); 2761 4422 } elsif ($tag =~ /^[-\w]+$/) { 2762 4423 # find first matching value … … 2765 4426 defined $matches[0] or undef @matches; 2766 4427 } else { 2767 $self->Warn("Invalid tag name '$ tag'");4428 $self->Warn("Invalid tag name '${tag}'"); 2768 4429 } 2769 4430 if (defined $group and not $allGrp) { … … 2778 4439 unless ($doDups or $allTag or $allGrp) { 2779 4440 $tag = shift @matches; 2780 my $oldPriority = $ self->{PRIORITY}{$tag} || 1;4441 my $oldPriority = $$self{PRIORITY}{$tag} || 1; 2781 4442 foreach (@matches) { 2782 my $priority = $ self->{PRIORITY}{$_};4443 my $priority = $$self{PRIORITY}{$_}; 2783 4444 $priority = 1 unless defined $priority; 2784 4445 next unless $priority >= $oldPriority; … … 2790 4451 } elsif (not @matches) { 2791 4452 # put entry in return list even without value (value is undef) 2792 $matches[0] = "$tag (0)";4453 $matches[0] = $byValue ? "$tag #(0)" : "$tag (0)"; 2793 4454 # bogus file order entry to avoid warning if sorting in file order 2794 $ self->{FILE_ORDER}{$matches[0]} =999;4455 $$self{FILE_ORDER}{$matches[0]} = 9999; 2795 4456 } 2796 4457 # save indices of tags extracted by value 2797 4458 push @byValue, scalar(@$rtnTags) .. (scalar(@$rtnTags)+scalar(@matches)-1) if $byValue; 4459 # save indices of wildcard tags 4460 push @wildTags, scalar(@$rtnTags) .. (scalar(@$rtnTags)+scalar(@matches)-1) if $allTag; 2798 4461 push @$rtnTags, @matches; 2799 4462 } … … 2802 4465 my @allTags; 2803 4466 if ($doDups) { 2804 @allTags = keys %{$ self->{VALUE}};4467 @allTags = keys %{$$self{VALUE}}; 2805 4468 } else { 2806 foreach (keys %{$self->{VALUE}}) { 2807 # only include tag if it doesn't end in a copy number 2808 push @allTags, $_ unless / /; 2809 } 4469 # only include tag if it doesn't end in a copy number 4470 @allTags = grep(!/ /, keys %{$$self{VALUE}}); 2810 4471 } 2811 4472 $rtnTags = \@allTags; … … 2823 4484 undef $group; 2824 4485 } elsif ($group !~ /^[-\w:]*$/) { 2825 $self->Warn("Invalid group name '$ group'");4486 $self->Warn("Invalid group name '${group}'"); 2826 4487 $group = 'invalid'; 2827 4488 } … … 2842 4503 } 2843 4504 if (%exclude) { 2844 my @filteredTags; 2845 $exclude{$_} or push @filteredTags, $_ foreach @$rtnTags; 2846 $rtnTags = \@filteredTags; # use new filtered tag list 2847 last unless @filteredTags; # all done if nothing left 4505 # remove excluded tags from return list(s) 4506 RemoveTagsFromList($rtnTags, \@byValue, \@wildTags, \%exclude); 4507 last unless @$rtnTags; # all done if nothing left 2848 4508 } 2849 4509 last if $duplicates and not @groupOptions; … … 2859 4519 $wantGroup{$family} or $wantGroup{$family} = { }; 2860 4520 my $groupList; 2861 if (ref $ options->{$groupOpt} eq 'ARRAY') {2862 $groupList = $ options->{$groupOpt};4521 if (ref $$options{$groupOpt} eq 'ARRAY') { 4522 $groupList = $$options{$groupOpt}; 2863 4523 } else { 2864 $groupList = [ $ options->{$groupOpt} ];4524 $groupList = [ $$options{$groupOpt} ]; 2865 4525 } 2866 4526 foreach (@$groupList) { … … 2894 4554 } 2895 4555 next unless $wantTag; 2896 if ($duplicates) { 2897 push @tags, $tag; 2898 } else { 2899 my $tagName = GetTagName($tag); 2900 my $bestTag = $bestTag{$tagName}; 2901 if (defined $bestTag) { 2902 next if $wantTag > $keepTags{$bestTag}; 2903 if ($wantTag == $keepTags{$bestTag}) { 2904 # want two tags with the same name -- keep the latest one 2905 if ($tag =~ / \((\d+)\)$/) { 2906 my $tagNum = $1; 2907 next if $bestTag !~ / \((\d+)\)$/ or $1 > $tagNum; 2908 } 4556 $duplicates and $keepTags{$tag} = 1, next; 4557 # determine which tag we want to keep 4558 my $tagName = GetTagName($tag); 4559 my $bestTag = $bestTag{$tagName}; 4560 if (defined $bestTag) { 4561 next if $wantTag > $keepTags{$bestTag}; 4562 if ($wantTag == $keepTags{$bestTag}) { 4563 # want two tags with the same name -- keep the latest one 4564 if ($tag =~ / \((\d+)\)$/) { 4565 my $tagNum = $1; 4566 next if $bestTag !~ / \((\d+)\)$/ or $1 > $tagNum; 2909 4567 } 2910 # this tag is better, so delete old best tag 2911 delete $keepTags{$bestTag}; 2912 } 2913 $keepTags{$tag} = $wantTag; # keep this tag (for now...) 2914 $bestTag{$tagName} = $tag; # this is our current best tag 2915 } 2916 } 2917 unless ($duplicates) { 2918 # construct new tag list with no duplicates, preserving order 2919 foreach $tag (@$rtnTags) { 2920 push @tags, $tag if $keepTags{$tag}; 2921 } 2922 } 2923 $rtnTags = \@tags; 4568 } 4569 # this tag is better, so delete old best tag 4570 delete $keepTags{$bestTag}; 4571 } 4572 $keepTags{$tag} = $wantTag; # keep this tag (for now...) 4573 $bestTag{$tagName} = $tag; # this is our current best tag 4574 } 4575 # include only tags we want to keep in return lists 4576 RemoveTagsFromList($rtnTags, \@byValue, \@wildTags, \%keepTags, 1); 2924 4577 last; 2925 4578 } 2926 $ self->{FOUND_TAGS} = $rtnTags; # save found tags4579 $$self{FOUND_TAGS} = $rtnTags; # save found tags 2927 4580 2928 4581 # return reference to found tag keys (and list of indices of tags to extract by value) 2929 return wantarray ? ($rtnTags, \@byValue ) : $rtnTags;4582 return wantarray ? ($rtnTags, \@byValue, \@wildTags) : $rtnTags; 2930 4583 } 2931 4584 … … 2934 4587 # Inputs: 0) autoload function, 1-N) function arguments 2935 4588 # Returns: result of function or dies if function not available 2936 # To Do: Generalize this routine so it works on systems that don't use '/'2937 # as a path name separator.2938 4589 sub DoAutoLoad(@) 2939 4590 { … … 2946 4597 # load Image/ExifTool/WriteMODULE.pl 2947 4598 $file .= "$callInfo[2].pl"; 4599 } elsif ($callInfo[-1] eq 'ShiftTime') { 4600 $file = 'Image/ExifTool/Shift.pl'; # load Shift.pl 2948 4601 } else { 2949 4602 # load Image/ExifTool/Writer.pl … … 2951 4604 } 2952 4605 # attempt to load the package 2953 eval "require '$file'"or die "Error while attempting to call $autoload\n$@\n";4606 eval { require $file } or die "Error while attempting to call $autoload\n$@\n"; 2954 4607 unless (defined &$autoload) { 2955 4608 my @caller = caller(0); … … 2971 4624 #------------------------------------------------------------------------------ 2972 4625 # Add warning tag 2973 # Inputs: 0) ExifTool object reference, 1) warning message, 2) true if minor 4626 # Inputs: 0) ExifTool object reference, 1) warning message 4627 # 2) true if minor (2 if behaviour changes when warning is ignored, 4628 # or 3 if warning shouldn't be issued when Validate option is used) 2974 4629 # Returns: true if warning tag was added 2975 4630 sub Warn($$;$) … … 2977 4632 my ($self, $str, $ignorable) = @_; 2978 4633 if ($ignorable) { 2979 return 0 if $self->{OPTIONS}{IgnoreMinorErrors}; 2980 $str = "[minor] $str"; 4634 return 0 if $$self{OPTIONS}{IgnoreMinorErrors}; 4635 return 0 if $ignorable eq '3' and $$self{OPTIONS}{Validate}; 4636 $str = $ignorable eq '2' ? "[Minor] $str" : "[minor] $str"; 2981 4637 } 2982 4638 $self->FoundTag('Warning', $str); … … 2991 4647 { 2992 4648 my ($self, $str, $ignorable) = @_; 2993 return 0 if $ignorable and $ self->{OPTIONS}{IgnoreMinorErrors};4649 return 0 if $ignorable and $$self{OPTIONS}{IgnoreMinorErrors}; 2994 4650 unless ($$self{WARNED_ONCE}{$str}) { 2995 4651 $self->Warn($str, $ignorable); … … 3006 4662 { 3007 4663 my ($self, $str, $ignorable) = @_; 3008 if ($ ignorable) {3009 if ($self->{OPTIONS}{IgnoreMinorErrors}) {3010 $self->Warn($str);3011 return 0;3012 }4664 if ($$self{DemoteErrors}) { 4665 $self->Warn($str) and ++$$self{DemoteErrors}; 4666 return 1; 4667 } elsif ($ignorable) { 4668 $$self{OPTIONS}{IgnoreMinorErrors} and $self->Warn($str), return 0; 3013 4669 $str = "[minor] $str"; 3014 4670 } … … 3116 4772 # Add hash of Composite tags to our composites 3117 4773 # Inputs: 0) hash reference to table of Composite tags to add or module name, 3118 # 1) over write existing tag4774 # 1) override existing tag definition 3119 4775 sub AddCompositeTags($;$) 3120 4776 { 3121 4777 local $_; 3122 my ($add, $over write) = @_;3123 my $module;4778 my ($add, $override) = @_; 4779 my ($module, $prefix, $tagID); 3124 4780 unless (ref $add) { 4781 ($prefix = $add) =~ s/.*:://; 3125 4782 $module = $add; 3126 4783 $add .= '::Composite'; 3127 4784 no strict 'refs'; 3128 4785 $add = \%$add; 4786 $prefix .= '-'; 4787 } else { 4788 $prefix = 'UserDefined-'; 3129 4789 } 3130 4790 my $defaultGroups = $$add{GROUPS}; 4791 my $compTable = GetTagTable('Image::ExifTool::Composite'); 3131 4792 3132 4793 # make sure default groups are defined in families 0 and 1 3133 4794 if ($defaultGroups) { 3134 $ defaultGroups->{0} or $defaultGroups->{0} = 'Composite';3135 $ defaultGroups->{1} or $defaultGroups->{1} = 'Composite';3136 $ defaultGroups->{2} or $defaultGroups->{2} = 'Other';4795 $$defaultGroups{0} or $$defaultGroups{0} = 'Composite'; 4796 $$defaultGroups{1} or $$defaultGroups{1} = 'Composite'; 4797 $$defaultGroups{2} or $$defaultGroups{2} = 'Other'; 3137 4798 } else { 3138 4799 $defaultGroups = $$add{GROUPS} = { 0 => 'Composite', 1 => 'Composite', 2 => 'Other' }; 3139 4800 } 3140 SetupTagTable($add); # generate tag Name, etc 3141 my $tagID; 4801 SetupTagTable($add); # generate Name, TagID, etc 3142 4802 foreach $tagID (sort keys %$add) { 3143 4803 next if $specialTags{$tagID}; # must skip special tags 3144 4804 my $tagInfo = $$add{$tagID}; 3145 # tagID's MUST be the exact tag name for logic in BuildCompositeTags() 3146 my $tag = $$tagInfo{Name}; 4805 my $new = $prefix . $tagID; # new tag ID for Composite table 3147 4806 $$tagInfo{Module} = $module if $$tagInfo{Writable}; 3148 # allow Composite tags with the same name 3149 my ($t, $n, $type); 3150 while ($Image::ExifTool::Composite{$tag} and not $overwrite) { 3151 $n ? $n += 1 : ($n = 2, $t = $tag); 3152 $tag = "${t}_$n"; 3153 $$tagInfo{NewTagID} = $tag; # save new ID so we can use it in TagLookup 3154 } 3155 # convert scalar Require/Desire entries 3156 foreach $type ('Require','Desire') { 4807 $$tagInfo{Override} = 1 if $override and not defined $$tagInfo{Override}; 4808 $$tagInfo{IsComposite} = 1; 4809 # handle Composite tags with the same name 4810 if ($compositeID{$tagID}) { 4811 # determine if we want to override this tag 4812 # (=0 keep both, >0 override, <0 keep existing) 4813 my $over = ($$tagInfo{Override} || 0) - ($$compTable{$compositeID{$tagID}[0]}{Override} || 0); 4814 next if $over < 0; 4815 if ($over) { 4816 # remove existing tags with this ID 4817 delete $$compTable{$_} foreach @{$compositeID{$tagID}}; 4818 delete $compositeID{$tagID}; 4819 } 4820 } 4821 # make sure new TagID is unique by adding index if necessary 4822 # (could only happen for UserDefined tags now that module name is added to tag ID) 4823 my $n = 0; 4824 while ($$compTable{$new}) { 4825 $new =~ s/-\d+$// if $n++; 4826 $new .= "-$n"; 4827 } 4828 # use new ID and save it so we can use it in TagLookup 4829 $$tagInfo{NewTagID} = $new unless $tagID eq $new; 4830 4831 # add new ID to lookup of Composite tag ID's 4832 $compositeID{$tagID} = [ ] unless $compositeID{$tagID}; 4833 unshift @{$compositeID{$tagID}}, $new; # (most recent one first) 4834 4835 # convert scalar Require/Desire/Inhibit entries 4836 my ($type, @hashes, @scalars, %used); 4837 foreach $type ('Require','Desire','Inhibit') { 3157 4838 my $req = $$tagInfo{$type} or next; 3158 $$tagInfo{$type} = { 0 => $req } if ref($req) ne 'HASH'; 4839 push @{ref($req) eq 'HASH' ? \@hashes : \@scalars}, $type; 4840 } 4841 if (@scalars) { 4842 # make lookup for indices that are used 4843 foreach $type (@hashes) { 4844 $used{$_} = 1 foreach keys %{$$tagInfo{$type}}; 4845 } 4846 my $next = 0; 4847 foreach $type (@scalars) { 4848 ++$next while $used{$next}; 4849 $$tagInfo{$type} = { $next++ => $$tagInfo{$type} }; 4850 } 3159 4851 } 3160 4852 # add this Composite tag to our main Composite table 3161 $$tagInfo{Table} = \%Image::ExifTool::Composite;3162 # (use the original TagID, even if we changed it )3163 # $$tagInfo{TagID} = $tag;3164 # save new tag ID so we can find entryin Composite table3165 $ Image::ExifTool::Composite{$tag} = $tagInfo;4853 $$tagInfo{Table} = $compTable; 4854 # (use the original TagID, even if we changed it, so don't do this:) 4855 $$tagInfo{TagID} = $new; 4856 # save tag under new ID in Composite table 4857 $$compTable{$new} = $tagInfo; 3166 4858 # set all default groups in tag 3167 4859 my $groups = $$tagInfo{Groups}; … … 3223 4915 { 3224 4916 my $tagTablePtr = shift; 4917 my $avoid = $$tagTablePtr{AVOID}; 3225 4918 my ($tagID, $tagInfo); 3226 4919 foreach $tagID (TagTableKeys($tagTablePtr)) { … … 3230 4923 $$tagInfo{Table} = $tagTablePtr; 3231 4924 $$tagInfo{TagID} = $tagID; 3232 my $tag = $$tagInfo{Name}; 3233 unless (defined $tag) { 3234 # generate name equal to tag ID if 'Name' doesn't exist 3235 $tag = $tagID; 3236 $$tagInfo{Name} = ucfirst($tag); # make first char uppercase 3237 } 4925 $$tagInfo{Name} or $$tagInfo{Name} = MakeTagName($tagID); 3238 4926 $$tagInfo{Flags} and ExpandFlags($tagInfo); 4927 $$tagInfo{Avoid} = $avoid if defined $avoid; 4928 # calculate BitShift from Mask if necessary 4929 if ($$tagInfo{Mask} and not defined $$tagInfo{BitShift}) { 4930 my ($mask, $bitShift) = ($$tagInfo{Mask}, 0); 4931 ++$bitShift until $mask & (1 << $bitShift); 4932 $$tagInfo{BitShift} = $bitShift; 4933 } 3239 4934 } 3240 4935 next unless @infoArray > 1; … … 3267 4962 { 3268 4963 my ($val, $sig) = @_; 3269 $val == 0 and return 0; 3270 my $sign = $val < 0 ? ($val=-$val, -1) : 1; 3271 my $log = log($val) / log(10); 3272 my $exp = int($log) - $sig + ($log > 0 ? 1 : 0); 3273 return $sign * int(10 ** ($log - $exp) + 0.5) * 10 ** $exp; 4964 return sprintf("%.${sig}g", $val); 3274 4965 } 3275 4966 … … 3396 5087 sub GetDouble($$) { return DoUnpackDbl('d', @_); } 3397 5088 sub Get16uRev($$) { return DoUnpackRev('S', @_); } 5089 sub Get32uRev($$) { return DoUnpackRev('L', @_); } 3398 5090 3399 5091 # rationals may be a floating point number, 'inf' or 'undef' 5092 my ($ratNumer, $ratDenom); 3400 5093 sub GetRational32s($$) 3401 5094 { 3402 5095 my ($dataPt, $pos) = @_; 3403 my $numer = Get16s($dataPt,$pos);3404 my $denom = Get16s($dataPt, $pos + 2) or return $numer ? 'inf' : 'undef';5096 $ratNumer = Get16s($dataPt,$pos); 5097 $ratDenom = Get16s($dataPt, $pos + 2) or return $ratNumer ? 'inf' : 'undef'; 3405 5098 # round off to a reasonable number of significant figures 3406 return RoundFloat($ numer / $denom, 7);5099 return RoundFloat($ratNumer / $ratDenom, 7); 3407 5100 } 3408 5101 sub GetRational32u($$) 3409 5102 { 3410 5103 my ($dataPt, $pos) = @_; 3411 my $numer = Get16u($dataPt,$pos);3412 my $denom = Get16u($dataPt, $pos + 2) or return $numer ? 'inf' : 'undef';3413 return RoundFloat($ numer / $denom, 7);5104 $ratNumer = Get16u($dataPt,$pos); 5105 $ratDenom = Get16u($dataPt, $pos + 2) or return $ratNumer ? 'inf' : 'undef'; 5106 return RoundFloat($ratNumer / $ratDenom, 7); 3414 5107 } 3415 5108 sub GetRational64s($$) 3416 5109 { 3417 5110 my ($dataPt, $pos) = @_; 3418 my $numer = Get32s($dataPt,$pos);3419 my $denom = Get32s($dataPt, $pos + 4) or return $numer ? 'inf' : 'undef';3420 return RoundFloat($ numer / $denom, 10);5111 $ratNumer = Get32s($dataPt,$pos); 5112 $ratDenom = Get32s($dataPt, $pos + 4) or return $ratNumer ? 'inf' : 'undef'; 5113 return RoundFloat($ratNumer / $ratDenom, 10); 3421 5114 } 3422 5115 sub GetRational64u($$) 3423 5116 { 3424 5117 my ($dataPt, $pos) = @_; 3425 my $numer = Get32u($dataPt,$pos);3426 my $denom = Get32u($dataPt, $pos + 4) or return $numer ? 'inf' : 'undef';3427 return RoundFloat($ numer / $denom, 10);5118 $ratNumer = Get32u($dataPt,$pos); 5119 $ratDenom = Get32u($dataPt, $pos + 4) or return $ratNumer ? 'inf' : 'undef'; 5120 return RoundFloat($ratNumer / $ratDenom, 10); 3428 5121 } 3429 5122 sub GetFixed16s($$) … … 3524 5217 int32s => 4, 3525 5218 int32u => 4, 5219 int32uRev => 4, 3526 5220 int64s => 8, 3527 5221 int64u => 8, … … 3534 5228 fixed32s => 4, 3535 5229 fixed32u => 4, 5230 fixed64s => 8, 3536 5231 float => 4, 3537 5232 double => 8, … … 3544 5239 ifd => 4, 3545 5240 ifd64 => 8, 5241 ue7 => 1, 3546 5242 ); 3547 5243 my %readValueProc = ( … … 3553 5249 int32s => \&Get32s, 3554 5250 int32u => \&Get32u, 5251 int32uRev => \&Get32uRev, 3555 5252 int64s => \&Get64s, 3556 5253 int64u => \&Get64u, … … 3563 5260 fixed32s => \&GetFixed32s, 3564 5261 fixed32u => \&GetFixed32u, 5262 fixed64s => \&GetFixed64s, 3565 5263 float => \&GetFloat, 3566 5264 double => \&GetDouble, … … 3569 5267 ifd64 => \&Get64u, 3570 5268 ); 5269 # lookup for all rational types 5270 my %isRational = ( 5271 rational32u => 1, 5272 rational32s => 1, 5273 rational64u => 1, 5274 rational64s => 1, 5275 ); 3571 5276 sub FormatSize($) { return $formatSize{$_[0]}; } 3572 5277 … … 3574 5279 # Read value from binary data (with current byte ordering) 3575 5280 # Inputs: 0) data reference, 1) value offset, 2) format string, 3576 # 3) number of values (or undef to use all data) 3577 # 4) valid data length relative to offset 5281 # 3) number of values (or undef to use all data), 5282 # 4) valid data length relative to offset (or undef to use all data), 5283 # 5) optional pointer to returned rational 3578 5284 # Returns: converted value, or undefined if data isn't there 3579 5285 # or list of values in list context 3580 sub ReadValue($$$ $$)3581 { 3582 my ($dataPt, $offset, $format, $count, $size ) = @_;5286 sub ReadValue($$$;$$$) 5287 { 5288 my ($dataPt, $offset, $format, $count, $size, $ratPt) = @_; 3583 5289 3584 5290 my $len = $formatSize{$format}; … … 3587 5293 $len = 1; 3588 5294 } 5295 $size = length($$dataPt) - $offset unless defined $size; 3589 5296 unless ($count) { 3590 5297 return '' if defined $count or $size < $len; … … 3598 5305 my @vals; 3599 5306 my $proc = $readValueProc{$format}; 3600 if ($proc) { 5307 if (not $proc) { 5308 # handle undef/binary/string (also unsupported unicode/complex) 5309 $vals[0] = substr($$dataPt, $offset, $count * $len); 5310 # truncate string at null terminator if necessary 5311 $vals[0] =~ s/\0.*//s if $format eq 'string'; 5312 } elsif ($isRational{$format} and $ratPt) { 5313 # store rationals separately as string fractions 5314 my @rat; 5315 for (;;) { 5316 push @vals, &$proc($dataPt, $offset); 5317 push @rat, "$ratNumer/$ratDenom"; 5318 last if --$count <= 0; 5319 $offset += $len; 5320 } 5321 $$ratPt = join(' ',@rat); 5322 } else { 3601 5323 for (;;) { 3602 5324 push @vals, &$proc($dataPt, $offset); … … 3604 5326 $offset += $len; 3605 5327 } 3606 } else {3607 # handle undef/binary/string (also unsupported unicode/complex)3608 $vals[0] = substr($$dataPt, $offset, $count * $len);3609 # truncate string at null terminator if necessary3610 $vals[0] =~ s/\0.*//s if $format eq 'string';3611 5328 } 3612 5329 return @vals if wantarray; … … 3706 5423 { 3707 5424 # issue warning only if the tag was specifically requested 3708 if ($ self->{REQ_TAG_LOOKUP}{lc GetTagName($tag)}) {5425 if ($$self{REQ_TAG_LOOKUP}{lc GetTagName($tag)}) { 3709 5426 $self->Warn("$tag is not a valid JPEG image",1); 3710 5427 return undef; … … 3712 5429 } 3713 5430 return $imagePt; 5431 } 5432 5433 #------------------------------------------------------------------------------ 5434 # Validate a tag name argument (including group name and wildcards, etc) 5435 # Inputs: 0) tag name 5436 # Returns: true if tag name is valid 5437 # - a tag name may contain [-_A-Za-z0-9], but may not start with [-0-9] 5438 # - tag names may contain wildcards [?*], and end with a hash [#] 5439 # - may have group name prefixes (which may have family number prefix), separated by colons 5440 # - a group name may be zero or more characters 5441 sub ValidTagName($) 5442 { 5443 my $tag = shift; 5444 return $tag =~ /^(([-\w]*|\d*\*):)*[_a-zA-Z?*][-\w?*]*#?$/; 5445 } 5446 5447 #------------------------------------------------------------------------------ 5448 # Generate a valid tag name based on the tag ID or name 5449 # Inputs: 0) tag ID or name 5450 # Returns: valid tag name 5451 sub MakeTagName($) 5452 { 5453 my $name = shift; 5454 $name =~ tr/-_a-zA-Z0-9//dc; # remove illegal characters 5455 $name = ucfirst $name; # capitalize first letter 5456 $name = "Tag$name" if length($name) < 2; # must at least 2 characters long 5457 return $name; 3714 5458 } 3715 5459 … … 3731 5475 # put a space between acronyms and words 3732 5476 $desc =~ s/([A-Z])([A-Z][a-z])/$1 $2/g; 3733 # put spaces after numbers (if more than one character follow ingnumber)5477 # put spaces after numbers (if more than one character follows the number) 3734 5478 $desc =~ s/(\d)([A-Z]\S)/$1 $2/g; 3735 5479 # add TagID to description … … 3739 5483 3740 5484 #------------------------------------------------------------------------------ 5485 # Get descriptions for all tags in an array 5486 # Inputs: 0) ExifTool ref, 1) reference to list of tag keys 5487 # Returns: reference to hash lookup for descriptions 5488 # Note: Returned descriptions are NOT escaped by ESCAPE_PROC 5489 sub GetDescriptions($$) 5490 { 5491 local $_; 5492 my ($self, $tags) = @_; 5493 my %desc; 5494 my $oldEscape = $$self{ESCAPE_PROC}; 5495 delete $$self{ESCAPE_PROC}; 5496 $desc{$_} = $self->GetDescription($_) foreach @$tags; 5497 $$self{ESCAPE_PROC} = $oldEscape; 5498 return \%desc; 5499 } 5500 5501 #------------------------------------------------------------------------------ 5502 # Apply filter to value(s) if necessary 5503 # Inputs: 0) ExifTool ref, 1) filter expression, 2) reference to value to filter 5504 # Returns: true unless a filter returned undef; changes value if necessary 5505 sub Filter($$$) 5506 { 5507 local $_; 5508 my ($self, $filter, $valPt) = @_; 5509 return 1 unless defined $filter and defined $$valPt; 5510 my $rtnVal; 5511 if (not ref $$valPt) { 5512 $_ = $$valPt; 5513 #### eval Filter ($_, $self) 5514 eval $filter; 5515 if (defined $_) { 5516 $$valPt = $_; 5517 $rtnVal = 1; 5518 } 5519 } elsif (ref $$valPt eq 'SCALAR') { 5520 my $val = $$$valPt; # make a copy to avoid filtering twice 5521 $rtnVal = $self->Filter($filter, \$val); 5522 $$valPt = \$val; 5523 } elsif (ref $$valPt eq 'ARRAY') { 5524 my @val = @{$$valPt}; # make a copy to avoid filtering twice 5525 $self->Filter($filter, \$_) and $rtnVal = 1 foreach @val; 5526 $$valPt = \@val; 5527 } elsif (ref $$valPt eq 'HASH') { 5528 my %val = %{$$valPt}; # make a copy to avoid filtering twice 5529 $self->Filter($filter, \$val{$_}) and $rtnVal = 1 foreach keys %val; 5530 $$valPt = \%val; 5531 } else { 5532 $rtnVal = 1; 5533 } 5534 return $rtnVal; 5535 } 5536 5537 #------------------------------------------------------------------------------ 3741 5538 # Return printable value 3742 5539 # Inputs: 0) ExifTool object reference … … 3748 5545 $outStr =~ tr/\x01-\x1f\x7f-\xff/./; 3749 5546 $outStr =~ s/\x00//g; 3750 if (defined $maxLen) { 3751 # minimum length is 20 (0 is unlimited) 3752 $maxLen = 20 if $maxLen and $maxLen < 20; 5547 my $verbose = $$self{OPTIONS}{Verbose}; 5548 if ($verbose < 4) { 5549 if ($maxLen) { 5550 $maxLen = 20 if $maxLen < 20; # minimum length is 20 5551 } elsif (defined $maxLen) { 5552 $maxLen = length $outStr; # 0 is unlimited 5553 } else { 5554 $maxLen = 60; # default maximum is 60 5555 } 3753 5556 } else { 3754 $maxLen = 60; # default length is 60 3755 } 3756 # limit length only if verbose < 4 3757 if ($maxLen and length($outStr) > $maxLen and $self->{OPTIONS}{Verbose} < 4) { 3758 $outStr = substr($outStr,0,$maxLen-6) . '[snip]'; 3759 } 5557 $maxLen = length $outStr; 5558 # limit to 2048 characters if verbose < 5 5559 $maxLen = 2048 if $maxLen > 2048 and $verbose < 5; 5560 } 5561 5562 # limit length if necessary 5563 $outStr = substr($outStr,0,$maxLen-6) . '[snip]' if length($outStr) > $maxLen; 3760 5564 return $outStr; 3761 5565 } … … 3768 5572 { 3769 5573 my ($self, $date) = @_; 3770 my $dateFormat = $self->{OPTIONS}{DateFormat}; 5574 my $fmt = $$self{OPTIONS}{DateFormat}; 5575 my $shift = $$self{OPTIONS}{GlobalTimeShift}; 5576 if ($shift) { 5577 my $dir = ($shift =~ s/^([-+])// and $1 eq '-') ? -1 : 1; 5578 my $offset = $$self{GLOBAL_TIME_OFFSET}; 5579 $offset or $offset = $$self{GLOBAL_TIME_OFFSET} = { }; 5580 ShiftTime($date, $shift, $dir, $offset); 5581 } 3771 5582 # only convert date if a format was specified and the date is recognizable 3772 if ($dateFormat) { 5583 if ($fmt) { 5584 # separate time zone if it exists 5585 my $tz; 5586 $date =~ s/([-+]\d{2}:\d{2}|Z)$// and $tz = $1; 3773 5587 # a few cameras use incorrect date/time formatting: 3774 5588 # - slashes instead of colons in date (RolleiD330, ImpressCam) 3775 5589 # - date/time values separated by colon instead of space (Polariod, Sanyo, Sharp, Vivitar) 3776 5590 # - single-digit seconds with leading space (HP scanners) 3777 $date =~ s/[-+]\d{2}:\d{2}$//; # remove timezone if it exists 3778 my @a = ($date =~ /\d+/g); # be very flexible about date/time format 3779 if (@a and $a[0] > 1900 and $a[0] < 3000 and eval 'require POSIX') { 3780 $date = POSIX::strftime($dateFormat, $a[5]||0, $a[4]||0, $a[3]||0, 3781 $a[2]||1, ($a[1]||1)-1, $a[0]-1900); 3782 } elsif ($self->{OPTIONS}{StrictDate}) { 5591 my @a = reverse ($date =~ /\d+/g); # be very flexible about date/time format 5592 if (@a and $a[-1] >= 1000 and $a[-1] < 3000 and eval { require POSIX }) { 5593 shift @a while @a > 6; # remove superfluous entries 5594 unshift @a, 1 while @a < 3; # add month and day if necessary 5595 unshift @a, 0 while @a < 6; # add h,m,s if necessary 5596 $a[4] -= 1; # base month is 1 5597 # parse %z and %s ourself (to handle time zones properly) 5598 if ($fmt =~ /%[sz]/) { 5599 # use system time zone unless otherwise specified 5600 $tz = TimeZoneString(\@a, TimeLocal(@a)) if not $tz and eval { require Time::Local }; 5601 # remove colon, setting to UTC if time zone is not numeric 5602 $tz = ($tz and $tz=~/^([-+]\d{2}):(\d{2})$/) ? "$1$2" : '+0000'; 5603 $fmt =~ s/(^|[^%])((%%)*)%z/$1$2$tz/g; # convert '%z' format codes 5604 if ($fmt =~ /%s/ and eval { require Time::Local }) { 5605 # calculate seconds since the Epoch, UTC 5606 my $s = Time::Local::timegm(@a) - 60 * ($tz - int($tz/100) * 40); 5607 $fmt =~ s/(^|[^%])((%%)*)%s/$1$2$s/g; # convert '%s' format codes 5608 } 5609 } 5610 $a[5] -= 1900; # strftime year starts from 1900 5611 $date = POSIX::strftime($fmt, @a); # generate the formatted date/time 5612 } elsif ($$self{OPTIONS}{StrictDate}) { 3783 5613 undef $date; 3784 5614 } … … 3832 5662 # Inputs: 0) localtime array ref, 1) gmtime array ref 3833 5663 # Returns: time zone offset in minutes 3834 sub GetTimeZone( ;$$)5664 sub GetTimeZone($$) 3835 5665 { 3836 5666 my ($tm, $gm) = @_; … … 3843 5673 $min += ($$tm[3] - $$gm[3]) * 24 * 60; 3844 5674 } 5675 # MirBSD patch to round to the nearest 30 minutes because 5676 # it includes leap seconds in localtime but not gmtime 5677 $min = int($min / 30 + ($min > 0 ? 0.5 : -0.5)) * 30 if $^O eq 'mirbsd'; 3845 5678 return $min; 3846 5679 } … … 3860 5693 my $sign = '+'; 3861 5694 $min < 0 and $sign = '-', $min = -$min; 5695 $min = int($min + 0.5); # round off to nearest minute 3862 5696 my $h = int($min / 60); 3863 5697 return sprintf('%s%.2d:%.2d', $sign, $h, $min - $h * 60); … … 3866 5700 #------------------------------------------------------------------------------ 3867 5701 # Convert Unix time to EXIF date/time string 3868 # Inputs: 0) Unix time value, 1) non-zero to convert to local time 5702 # Inputs: 0) Unix time value, 1) non-zero to convert to local time, 5703 # 2) number of digits after the decimal for fractional seconds 3869 5704 # Returns: EXIF date/time string (with timezone for local times) 3870 # Notes: fractional seconds are ignored 3871 sub ConvertUnixTime($;$) 3872 { 3873 my ($time, $toLocal) = @_; 5705 sub ConvertUnixTime($;$$) 5706 { 5707 my ($time, $toLocal, $dec) = @_; 3874 5708 return '0000:00:00 00:00:00' if $time == 0; 3875 5709 my (@tm, $tz); 5710 if ($dec) { 5711 my $frac = $time - int($time); 5712 $time = int($time); 5713 $frac < 0 and $frac += 1, $time -= 1; 5714 $dec = sprintf('%.*f', $dec, $frac); 5715 # remove number before decimal and increment integer time if it was rounded up 5716 $dec =~ s/^(\d)// and $1 eq '1' and $time += 1; 5717 } else { 5718 $time = int($time + 1e-6) if $time != int($time); # avoid round-off errors 5719 $dec = ''; 5720 } 3876 5721 if ($toLocal) { 3877 5722 @tm = localtime($time); … … 3881 5726 $tz = ''; 3882 5727 } 3883 my $str = sprintf("%4d:%.2d:%.2d %.2d:%.2d:%.2d %s",5728 my $str = sprintf("%4d:%.2d:%.2d %.2d:%.2d:%.2d$dec%s", 3884 5729 $tm[5]+1900, $tm[4]+1, $tm[3], $tm[2], $tm[1], $tm[0], $tz); 3885 5730 return $str; … … 3888 5733 #------------------------------------------------------------------------------ 3889 5734 # Get Unix time from EXIF-formatted date/time string with optional timezone 3890 # Inputs: 0) EXIF date/time string, 1) non-zero if time is local 5735 # Inputs: 0) EXIF date/time string, 1) non-zero if time is local, or 2 to assume UTC 3891 5736 # Returns: Unix time (seconds since 0:00 GMT Jan 1, 1970) or undefined on error 3892 5737 sub GetUnixTime($;$) … … 3894 5739 my ($timeStr, $isLocal) = @_; 3895 5740 return 0 if $timeStr eq '0000:00:00 00:00:00'; 3896 my @tm = ($timeStr =~ /^(\d+):(\d+):(\d+)\s+(\d+):(\d+):(\d+) /);3897 return undef unless @tm == 6 and eval 'require Time::Local';3898 my $tzsec = 0;5741 my @tm = ($timeStr =~ /^(\d+):(\d+):(\d+)\s+(\d+):(\d+):(\d+)(.*)/); 5742 return undef unless @tm == 7 and eval { require Time::Local }; 5743 my ($tzStr, $tzSec) = (pop(@tm), 0); 3899 5744 # use specified timezone offset (if given) instead of local system time 3900 5745 # if we are converting a local time value 3901 if ($isLocal and $timeStr =~ /(?:Z|([-+])(\d+):(\d+))$/i) { 3902 # use specified timezone if one exists 3903 $tzsec = ($2 * 60 + $3) * ($1 eq '-' ? -60 : 60) if $1; 3904 undef $isLocal; # convert using GMT corrected for specified timezone 3905 } 3906 $tm[0] -= 1900; # convert year 5746 if ($isLocal) { 5747 if ($tzStr =~ /(?:Z|([-+])(\d+):(\d+))/i) { 5748 # use specified timezone if one exists 5749 $tzSec = ($2 * 60 + $3) * ($1 eq '-' ? -60 : 60) if $1; 5750 undef $isLocal; # convert using GMT corrected for specified timezone 5751 } elsif ($isLocal eq '2') { 5752 undef $isLocal; 5753 } 5754 } 3907 5755 $tm[1] -= 1; # convert month 3908 5756 @tm = reverse @tm; # change to order required by timelocal() 3909 return $isLocal ? TimeLocal(@tm) : Time::Local::timegm(@tm) - $tzsec; 5757 my $val = $isLocal ? TimeLocal(@tm) : Time::Local::timegm(@tm) - $tzSec; 5758 # handle fractional seconds 5759 $val += $1 if $tzStr and $tzStr =~ /^(\.\d+)/; 5760 return $val; 3910 5761 } 3911 5762 … … 3918 5769 my $val = shift; 3919 5770 $val < 2048 and return "$val bytes"; 3920 $val < 10240 and return sprintf('%.1f kB', $val / 1024); 3921 $val < 2097152 and return sprintf('%.0f kB', $val / 1024); 3922 $val < 10485760 and return sprintf('%.1f MB', $val / 1048576); 3923 return sprintf('%.0f MB', $val / 1048576); 5771 $val < 10240 and return sprintf('%.1f KiB', $val / 1024); 5772 $val < 2097152 and return sprintf('%.0f KiB', $val / 1024); 5773 $val < 10485760 and return sprintf('%.1f MiB', $val / 1048576); 5774 $val < 2147483648 and return sprintf('%.0f MiB', $val / 1048576); 5775 $val < 10737418240 and return sprintf('%.1f GiB', $val / 1073741824); 5776 return sprintf('%.0f GiB', $val / 1073741824); 3924 5777 } 3925 5778 … … 3927 5780 # Convert seconds to duration string (handles negative durations) 3928 5781 # Inputs: 0) floating point seconds 3929 # Returns: duration string in form "S.SS s", " MM:SS" or "H:MM:SS"5782 # Returns: duration string in form "S.SS s", "H:MM:SS" or "DD days HH:MM:SS" 3930 5783 sub ConvertDuration($) 3931 5784 { … … 3935 5788 my $sign = ($time > 0 ? '' : (($time = -$time), '-')); 3936 5789 return sprintf("$sign%.2f s", $time) if $time < 30; 5790 $time += 0.5; # to round off to nearest second 3937 5791 my $h = int($time / 3600); 3938 5792 $time -= $h * 3600; 3939 5793 my $m = int($time / 60); 3940 5794 $time -= $m * 60; 5795 if ($h > 24) { 5796 my $d = int($h / 24); 5797 $h -= $d * 24; 5798 $sign = "$sign$d days "; 5799 } 3941 5800 return sprintf("$sign%d:%.2d:%.2d", $h, $m, int($time)); 3942 5801 } … … 3961 5820 3962 5821 #------------------------------------------------------------------------------ 5822 # Convert file name for printing 5823 # Inputs: 0) ExifTool ref, 1) file name in CharsetFileName character set 5824 # Returns: converted file name in external character set 5825 sub ConvertFileName($$) 5826 { 5827 my ($self, $val) = @_; 5828 my $enc = $$self{OPTIONS}{CharsetFileName}; 5829 $val = $self->Decode($val, $enc) if $enc; 5830 return $val; 5831 } 5832 5833 #------------------------------------------------------------------------------ 5834 # Inverse conversion for file name (encode in CharsetFileName) 5835 # Inputs: 0) ExifTool ref, 1) file name in external character set 5836 # Returns: file name in CharsetFileName character set 5837 sub InverseFileName($$) 5838 { 5839 my ($self, $val) = @_; 5840 my $enc = $$self{OPTIONS}{CharsetFileName}; 5841 $val = $self->Encode($val, $enc) if $enc; 5842 $val =~ tr/\\/\//; # make sure we are using forward slashes 5843 return $val; 5844 } 5845 5846 #------------------------------------------------------------------------------ 3963 5847 # Save information for HTML dump 3964 5848 # Inputs: 0) ExifTool hash ref, 1) start offset, 2) data size 3965 # 3) comment string, 4) tool tip (or SAME), 5) flags 3966 sub HDump($$$$;$$ )5849 # 3) comment string, 4) tool tip (or SAME), 5) flags, 6) IFD name 5850 sub HDump($$$$;$$$) 3967 5851 { 3968 5852 my $self = shift; 3969 my $pos = shift; 5853 $$self{HTML_DUMP} or return; 5854 my ($pos, $len, $com, $tip, $flg, $ifd) = @_; 3970 5855 $pos += $$self{BASE} if $$self{BASE}; 3971 $$self{HTML_DUMP} and $self->{HTML_DUMP}->Add($pos, @_); 3972 } 3973 3974 #------------------------------------------------------------------------------ 3975 # JPEG constants 3976 my %jpegMarker = ( 3977 0x01 => 'TEM', 3978 0xc0 => 'SOF0', # to SOF15, with a few exceptions below 3979 0xc4 => 'DHT', 3980 0xc8 => 'JPGA', 3981 0xcc => 'DAC', 3982 0xd0 => 'RST0', 3983 0xd8 => 'SOI', 3984 0xd9 => 'EOI', 3985 0xda => 'SOS', 3986 0xdb => 'DQT', 3987 0xdc => 'DNL', 3988 0xdd => 'DRI', 3989 0xde => 'DHP', 3990 0xdf => 'EXP', 3991 0xe0 => 'APP0', # to APP15 3992 0xf0 => 'JPG0', 3993 0xfe => 'COM', 3994 ); 3995 3996 #------------------------------------------------------------------------------ 3997 # Get JPEG marker name 3998 # Inputs: 0) Jpeg number 3999 # Returns: marker name 4000 sub JpegMarkerName($) 4001 { 4002 my $marker = shift; 4003 my $markerName = $jpegMarker{$marker}; 4004 unless ($markerName) { 4005 $markerName = $jpegMarker{$marker & 0xf0}; 4006 if ($markerName and $markerName =~ /^([A-Z]+)\d+$/) { 4007 $markerName = $1 . ($marker & 0x0f); 4008 } else { 4009 $markerName = sprintf("marker 0x%.2x", $marker); 4010 } 4011 } 4012 return $markerName; 5856 # skip structural data blocks which have been removed from the middle of this dump 5857 # (SkipData list contains ordered [start,end+1] offsets to skip) 5858 if ($$self{SkipData}) { 5859 my $end = $pos + $len; 5860 my $skip; 5861 foreach $skip (@{$$self{SkipData}}) { 5862 $end <= $$skip[0] and last; 5863 $pos >= $$skip[1] and $pos += $$skip[1] - $$skip[0], next; 5864 if ($pos != $$skip[0]) { 5865 $$self{HTML_DUMP}->Add($pos, $$skip[0]-$pos, $com, $tip, $flg, $ifd); 5866 $len -= $$skip[0] - $pos; 5867 $tip = 'SAME'; 5868 } 5869 $pos = $$skip[1]; 5870 } 5871 } 5872 $$self{HTML_DUMP}->Add($pos, $len, $com, $tip, $flg, $ifd); 4013 5873 } 4014 5874 … … 4041 5901 { 4042 5902 $type = 'MIE'; 5903 } elsif ($buff =~ /\0\0(QDIOBS|SEFT)$/) { 5904 $type = 'Samsung'; 5905 } elsif ($buff =~ /8db42d694ccc418790edff439fe026bf$/s) { 5906 $type = 'Insta360'; 4043 5907 } 4044 5908 last; … … 4072 5936 4073 5937 for (;;) { # loop through all trailers 4074 require "Image/ExifTool/$dirName.pm"; 4075 my $proc = "Image::ExifTool::${dirName}::Process$dirName"; 4076 my $outBuff; 5938 my ($proc, $outBuff); 5939 if ($dirName eq 'Insta360') { 5940 require "Image/ExifTool/QuickTimeStream.pl"; 5941 $proc = 'Image::ExifTool::QuickTime::ProcessInsta360'; 5942 } else { 5943 require "Image/ExifTool/$dirName.pm"; 5944 $proc = "Image::ExifTool::${dirName}::Process$dirName"; 5945 } 4077 5946 if ($outfile) { 4078 5947 # write to local buffer so we can add trailer in proper order later … … 4089 5958 4090 5959 # read or write this trailer 4091 # (proc takes Offset as offset from end of trailer to end of file, 4092 # and returns DataPos and DirLen, and Fixup if applicable) 5960 # (proc takes Offset as positive offset from end of trailer to end of file, 5961 # and returns DataPos and DirLen, and Fixup if applicable, and updates 5962 # OutFile when writing) 4093 5963 no strict 'refs'; 4094 5964 my $result = &$proc($self, $dirInfo); 4095 5965 use strict 'refs'; 4096 5966 4097 # restore PATH 4098 pop @$path;4099 pop @$path; 5967 # restore PATH (pop last 2 items) 5968 splice @$path, -2; 5969 4100 5970 # check result 4101 5971 if ($outfile) { … … 4108 5978 $outBuff = ''; # free memory 4109 5979 } 4110 if ($fixup) { 4111 # add new fixup information if any 4112 $fixup->AddFixup($$dirInfo{Fixup}) if $$dirInfo{Fixup}; 4113 } else { 5980 if ($$dirInfo{Fixup}) { 5981 if ($fixup) { 5982 # add fixup for subsequent trailers to the fixup for this trailer 5983 # (but first we must adjust for the new start position) 5984 $$fixup{Shift} += $$dirInfo{Fixup}{Start}; 5985 $$fixup{Start} -= $$dirInfo{Fixup}{Start}; 5986 $$dirInfo{Fixup}->AddFixup($fixup); 5987 } 4114 5988 $fixup = $$dirInfo{Fixup}; # save fixup 4115 5989 } 4116 5990 } else { 4117 $success = 0 if $self->Error("Error rewriting $dirName trailer", 1);5991 $success = 0 if $self->Error("Error rewriting $dirName trailer", 2); 4118 5992 last; 4119 5993 } … … 4139 6013 4140 6014 #------------------------------------------------------------------------------ 4141 # Extract EXIF information from a jpg image 6015 # JPEG constants 6016 6017 # JPEG marker names 6018 %jpegMarker = ( 6019 0x00 => 'NULL', 6020 0x01 => 'TEM', 6021 0xc0 => 'SOF0', # to SOF15, with a few exceptions below 6022 0xc4 => 'DHT', 6023 0xc8 => 'JPGA', 6024 0xcc => 'DAC', 6025 0xd0 => 'RST0', # to RST7 6026 0xd8 => 'SOI', 6027 0xd9 => 'EOI', 6028 0xda => 'SOS', 6029 0xdb => 'DQT', 6030 0xdc => 'DNL', 6031 0xdd => 'DRI', 6032 0xde => 'DHP', 6033 0xdf => 'EXP', 6034 0xe0 => 'APP0', # to APP15 6035 0xf0 => 'JPG0', 6036 0xfe => 'COM', 6037 ); 6038 6039 # lookup for size of JPEG marker length word 6040 # (2 bytes assumed unless specified here) 6041 my %markerLenBytes = ( 6042 0x00 => 0, 0x01 => 0, 6043 0xd0 => 0, 0xd1 => 0, 0xd2 => 0, 0xd3 => 0, 0xd4 => 0, 0xd5 => 0, 0xd6 => 0, 0xd7 => 0, 6044 0xd8 => 0, 0xd9 => 0, 0xda => 0, 6045 # J2C 6046 0x30 => 0, 0x31 => 0, 0x32 => 0, 0x33 => 0, 0x34 => 0, 0x35 => 0, 0x36 => 0, 0x37 => 0, 6047 0x38 => 0, 0x39 => 0, 0x3a => 0, 0x3b => 0, 0x3c => 0, 0x3d => 0, 0x3e => 0, 0x3f => 0, 6048 0x4f => 0, 6049 0x92 => 0, 0x93 => 0, 6050 # J2C extensions 6051 0x74 => 4, 0x75 => 4, 0x77 => 4, 6052 ); 6053 6054 #------------------------------------------------------------------------------ 6055 # Get JPEG marker name 6056 # Inputs: 0) Jpeg number 6057 # Returns: marker name 6058 sub JpegMarkerName($) 6059 { 6060 my $marker = shift; 6061 my $markerName = $jpegMarker{$marker}; 6062 unless ($markerName) { 6063 $markerName = $jpegMarker{$marker & 0xf0}; 6064 if ($markerName and $markerName =~ /^([A-Z]+)\d+$/) { 6065 $markerName = $1 . ($marker & 0x0f); 6066 } else { 6067 $markerName = sprintf("marker 0x%.2x", $marker); 6068 } 6069 } 6070 return $markerName; 6071 } 6072 6073 #------------------------------------------------------------------------------ 6074 # Adjust directory start position 6075 # Inputs: 0) dirInfo ref, 1) start offset 6076 # 2) Base for offsets (relative to DataPos, defaults to absolute Base of 0) 6077 sub DirStart($$;$) 6078 { 6079 my ($dirInfo, $start, $base) = @_; 6080 $$dirInfo{DirStart} = $start; 6081 $$dirInfo{DirLen} -= $start; 6082 if (defined $base) { 6083 $$dirInfo{Base} = $$dirInfo{DataPos} + $base; 6084 $$dirInfo{DataPos} = -$base; # (relative to Base!) 6085 } 6086 } 6087 6088 #------------------------------------------------------------------------------ 6089 # Extract metadata from a jpg image 4142 6090 # Inputs: 0) ExifTool object reference, 1) dirInfo ref with RAF set 4143 6091 # Returns: 1 on success, 0 if this wasn't a valid JPEG file … … 4147 6095 my ($self, $dirInfo) = @_; 4148 6096 my ($ch, $s, $length); 4149 my $verbose = $self->{OPTIONS}{Verbose}; 4150 my $out = $self->{OPTIONS}{TextOut}; 4151 my $fast = $self->{OPTIONS}{FastScan}; 6097 my $options = $$self{OPTIONS}; 6098 my $verbose = $$options{Verbose}; 6099 my $out = $$options{TextOut}; 6100 my $fast = $$options{FastScan} || 0; 4152 6101 my $raf = $$dirInfo{RAF}; 4153 my $htmlDump = $ self->{HTML_DUMP};6102 my $htmlDump = $$self{HTML_DUMP}; 4154 6103 my %dumpParms = ( Out => $out ); 4155 my ($success, $icc_profile, $wantTrailer, $trailInfo, %extendedXMP); 4156 my ($preview, $scalado, @dqt, $subSampling, $dumpEnd); 4157 4158 # check to be sure this is a valid JPG file 4159 return 0 unless $raf->Read($s, 2) == 2 and $s eq "\xff\xd8"; 6104 my ($success, $wantTrailer, $trailInfo, $foundSOS); 6105 my (@iccChunk, $iccChunkCount, $iccChunksTotal, @flirChunk, $flirCount, $flirTotal); 6106 my ($preview, $scalado, @dqt, $subSampling, $dumpEnd, %extendedXMP); 6107 6108 # check to be sure this is a valid JPG (or J2C, or EXV) file 6109 return 0 unless $raf->Read($s, 2) == 2 and $s =~ /^\xff[\xd8\x4f\x01]/; 6110 if ($s eq "\xff\x01") { 6111 return 0 unless $raf->Read($s, 5) == 5 and $s eq 'Exiv2'; 6112 $$self{FILE_TYPE} = 'EXV'; 6113 } 6114 my $appBytes = 0; 6115 my $calcImageLen = $$self{REQ_TAG_LOOKUP}{jpegimagelength}; 6116 if ($$options{RequestAll} and $$options{RequestAll} > 2) { 6117 $calcImageLen = 1; 6118 } 6119 if (not $$self{VALUE}{FileType} or ($$self{DOC_NUM} and $$options{ExtractEmbedded})) { 6120 $self->SetFileType(); # set FileType tag 6121 return 1 if $fast == 3; # don't process file when FastScan == 3 6122 $$self{LOW_PRIORITY_DIR}{IFD1} = 1; # lower priority of IFD1 tags 6123 } 6124 $$raf{NoBuffer} = 1 if $self->Options('FastScan'); # disable buffering in FastScan mode 6125 4160 6126 $dumpParms{MaxLen} = 128 if $verbose < 4; 4161 unless ($self->{VALUE}{FileType}) {4162 $self->SetFileType(); # set FileType tag4163 $$self{LOW_PRIORITY_DIR}{IFD1} = 1; # lower priority of IFD1 tags4164 }4165 6127 if ($htmlDump) { 4166 6128 $dumpEnd = $raf->Tell(); 4167 my $pos = $dumpEnd - 2; 6129 my ($n, $t, $m) = $s eq 'Exiv2' ? (7,'EXV','TEM') : (2,'JPEG','SOI'); 6130 my $pos = $dumpEnd - $n; 4168 6131 $self->HDump(0, $pos, '[unknown header]') if $pos; 4169 $self->HDump($pos, 2, 'JPEG header', 'SOI Marker');6132 $self->HDump($pos, $n, "$t header", "$m Marker"); 4170 6133 } 4171 6134 my $path = $$self{PATH}; … … 4175 6138 local $/ = "\xff"; 4176 6139 4177 my ($nextMarker, $nextSegDataPt, $nextSegPos, $combinedSegData );6140 my ($nextMarker, $nextSegDataPt, $nextSegPos, $combinedSegData, $firstSegPos, @skipData); 4178 6141 4179 6142 # read file until we reach an end of image (EOI) or start of scan (SOS) … … 4186 6149 undef $nextSegDataPt; 4187 6150 # 4188 # read ahead to the next segment unless we have reached EOI or SOS6151 # read ahead to the next segment unless we have reached EOI, SOS or SOD 4189 6152 # 4190 unless ($marker and ($marker==0xd9 or ($marker==0xda and not $wantTrailer) )) {6153 unless ($marker and ($marker==0xd9 or ($marker==0xda and not $wantTrailer) or $marker==0x93)) { 4191 6154 # read up to next marker (JPEG markers begin with 0xff) 4192 6155 my $buff; … … 4198 6161 last unless $nextMarker == 0xff; 4199 6162 } 4200 # read data for all markers except 0xd9 (EOI) and stand-alone 4201 # markers 0x00, 0x01 and 0xd0-0xd7 (NULL, TEM, RST0-RST7) 4202 if ($nextMarker!=0xd9 and $nextMarker!=0x00 and $nextMarker!=0x01 and 4203 ($nextMarker<0xd0 or $nextMarker>0xd7)) 4204 { 6163 # read segment data if it exists 6164 if (not defined $markerLenBytes{$nextMarker}) { 4205 6165 # read record length word 4206 6166 last unless $raf->Read($s, 2) == 2; … … 4211 6171 last unless $raf->Read($buff, $len) == $len; 4212 6172 $nextSegDataPt = \$buff; # set pointer to our next data 6173 } elsif ($markerLenBytes{$nextMarker} == 4) { 6174 # handle J2C extensions with 4-byte length word 6175 last unless $raf->Read($s, 4) == 4; 6176 my $len = unpack('N',$s); # get data length 6177 last unless defined($len) and $len >= 4; 6178 $nextSegPos = $raf->Tell(); 6179 $len -= 4; # subtract size of length word 6180 last unless $raf->Seek($len, 1); 4213 6181 } 4214 6182 # read second segment too if this was the first … … 4227 6195 print $out "JPEG $markerName ($length bytes):\n"; 4228 6196 HexDump($segDataPt, undef, %dumpParms, Addr=>$segPos) if $verbose>2; 6197 } elsif ($htmlDump) { 6198 $self->HDump($segPos-4, $length+4, "[JPEG $markerName]", undef, 0x08); 6199 $dumpEnd = $segPos + $length; 4229 6200 } 4230 6201 next unless $length >= 6; … … 4232 6203 my ($p, $h, $w, $n) = unpack('Cn2C', $$segDataPt); 4233 6204 my $sof = GetTagTable('Image::ExifTool::JPEG::SOF'); 4234 $self-> FoundTag($$sof{ImageWidth}, $w);4235 $self-> FoundTag($$sof{ImageHeight}, $h);4236 $self-> FoundTag($$sof{EncodingProcess}, $marker - 0xc0);4237 $self-> FoundTag($$sof{BitsPerSample}, $p);4238 $self-> FoundTag($$sof{ColorComponents}, $n);6205 $self->HandleTag($sof, 'ImageWidth', $w); 6206 $self->HandleTag($sof, 'ImageHeight', $h); 6207 $self->HandleTag($sof, 'EncodingProcess', $marker - 0xc0); 6208 $self->HandleTag($sof, 'BitsPerSample', $p); 6209 $self->HandleTag($sof, 'ColorComponents', $n); 4239 6210 next unless $n == 3 and $length >= 15; 4240 6211 my ($i, $hmin, $hmax, $vmin, $vmax); … … 4259 6230 if ($hmin and $vmin) { 4260 6231 my ($hs, $vs) = ($hmax / $hmin, $vmax / $vmin); 4261 $self-> FoundTag($$sof{YCbCrSubSampling}, "$hs $vs");6232 $self->HandleTag($sof, 'YCbCrSubSampling', "$hs $vs"); 4262 6233 } 4263 6234 next; … … 4271 6242 $dumpEnd = 0; 4272 6243 } 4273 $success = 1; 6244 if ($foundSOS or $$self{FILE_TYPE} eq 'EXV') { 6245 $success = 1; 6246 } else { 6247 $self->Warn('Missing JPEG SOS'); 6248 } 6249 if ($$self{REQ_TAG_LOOKUP}{trailer}) { 6250 # read entire trailer into memory 6251 if ($raf->Seek(0,2)) { 6252 my $len = $raf->Tell() - $pos; 6253 if ($len) { 6254 my $buff; 6255 $raf->Seek($pos, 0); 6256 $self->FoundTag(Trailer => \$buff) if $raf->Read($buff,$len) == $len; 6257 $raf->Seek($pos, 0); 6258 } 6259 } else { 6260 $self->Warn('Error seeking in file'); 6261 } 6262 } 4274 6263 # we are here because we are looking for trailer information 4275 6264 if ($wantTrailer) { 4276 6265 my $start = $$self{PreviewImageStart}; 4277 if ($start ) {6266 if ($start or $$options{ExtractEmbedded}) { 4278 6267 my $buff; 4279 6268 # most previews start right after the JPEG EOI, but the Olympus E-20 … … 4282 6271 # (and Minolta and Sony previews can have a random first byte...) 4283 6272 my $scanLen = $$self{Make} =~ /Sony/i ? 65536 : 1024; 4284 if ($raf->Read($buff, $scanLen) and ($buff =~ /\xff\xd8\xff./g or 4285 ($self->{Make} =~ /(Minolta|Sony)/i and $buff =~ /.\xd8\xff\xdb/g))) 4286 { 4287 # adjust PreviewImageStart to this location 4288 my $actual = $pos + pos($buff) - 4; 4289 if ($start ne $actual and $verbose > 1) { 4290 print $out "(Fixed PreviewImage location: $start -> $actual)\n"; 4291 } 4292 # update preview image offsets 4293 $self->{VALUE}{PreviewImageStart} = $actual if $self->{VALUE}{PreviewImageStart}; 4294 $$self{PreviewImageStart} = $actual; 4295 # load preview now if we tried and failed earlier 4296 if ($$self{PreviewError} and $$self{PreviewImageLength}) { 4297 if ($raf->Seek($actual, 0) and $raf->Read($buff, $$self{PreviewImageLength})) { 4298 $self->FoundTag('PreviewImage', $buff); 4299 delete $$self{PreviewError}; 6273 if ($raf->Read($buff, $scanLen)) { 6274 if ($buff =~ /^.{4}ftyp/s) { 6275 my $val; 6276 if ($raf->Seek(0,2)) { 6277 my $len = $raf->Tell() - $pos; 6278 if ($$options{Binary}) { 6279 $val = \$buff if $raf->Seek($pos,0) and $raf->Read($buff,$len)==$len; 6280 } else { 6281 $val = \ "Binary data $len bytes"; 6282 } 6283 if ($val) { 6284 $self->FoundTag('EmbeddedVideo', $val); 6285 } else { 6286 $self->Warn('Error reading trailer'); 6287 } 6288 } else { 6289 $self->Warn('Error seeking to end of file'); 6290 } 6291 } elsif ($buff =~ /\xff\xd8\xff./g or 6292 ($$self{Make} =~ /(Minolta|Sony)/i and $buff =~ /.\xd8\xff\xdb/g)) 6293 { 6294 # adjust PreviewImageStart to this location 6295 my $actual = $pos + pos($buff) - 4; 6296 if ($start and $start ne $actual and $verbose > 1) { 6297 print $out "(Fixed PreviewImage location: $start -> $actual)\n"; 6298 } 6299 # update preview image offsets 6300 if ($start) { 6301 $$self{VALUE}{PreviewImageStart} = $actual if $$self{VALUE}{PreviewImageStart}; 6302 $$self{PreviewImageStart} = $actual; 6303 } 6304 # load preview now if we tried and failed earlier 6305 if ($$self{PreviewError} and $$self{PreviewImageLength}) { 6306 if ($raf->Seek($actual, 0) and $raf->Read($buff, $$self{PreviewImageLength})) { 6307 $self->FoundTag('PreviewImage', $buff); 6308 delete $$self{PreviewError}; 6309 } 4300 6310 } 4301 6311 } … … 4333 6343 }) if $endPos > $pos; 4334 6344 } 6345 $self->FoundTag('JPEGImageLength', $pos - $appBytes) if $calcImageLen; 4335 6346 last; # all done parsing file 4336 6347 } elsif ($marker == 0xda) { # SOS 4337 6348 pop @$path; 6349 $foundSOS = 1; 4338 6350 # all done with meta information unless we have a trailer 4339 6351 $verbose and print $out "JPEG SOS\n"; … … 4346 6358 $self->ProcessTrailers($trailInfo) and undef $trailInfo; 4347 6359 } 4348 if ($wantTrailer ) {6360 if ($wantTrailer and $$self{PreviewImageStart}) { 4349 6361 # seek ahead and validate preview image 4350 6362 my $buff; … … 4363 6375 Image::ExifTool::Panasonic::ProcessLeicaTrailer($self); 4364 6376 $wantTrailer = 1 if $$self{LeicaTrailer}; 6377 } else { 6378 $wantTrailer = 1 if $$options{ExtractEmbedded}; 4365 6379 } 4366 6380 next if $trailInfo or $wantTrailer or $verbose > 2 or $htmlDump; 4367 6381 } 6382 # must scan to EOI if Validate or JpegCompressionFactor used 6383 next if $$options{Validate} or $calcImageLen or $$self{REQ_TAG_LOOKUP}{trailer}; 4368 6384 # nothing interesting to parse after start of scan (SOS) 4369 6385 $success = 1; 4370 6386 last; # all done parsing file 4371 } elsif ($marker==0x00 or $marker==0x01 or ($marker>=0xd0 and $marker<=0xd7)) { 4372 # handle stand-alone markers 0x00, 0x01 and 0xd0-0xd7 (NULL, TEM, RST0-RST7) 4373 $verbose and $marker and print $out "JPEG $markerName:\n"; 6387 } elsif ($marker == 0x93) { 6388 pop @$path; 6389 $verbose and print $out "JPEG SOD\n"; 6390 $success = 1; 6391 next if $verbose > 2 or $htmlDump; 6392 last; # all done parsing file 6393 } elsif (defined $markerLenBytes{$marker}) { 6394 # handle other stand-alone markers and segments we skipped over 6395 $verbose and $marker and print $out "JPEG $markerName\n"; 4374 6396 next; 4375 6397 } elsif ($marker == 0xdb and length($$segDataPt) and # DQT 4376 6398 # save the DQT data only if JPEGDigest has been requested 4377 $self->{REQ_TAG_LOOKUP}->{jpegdigest}) 6399 # (Note: since we aren't checking the RequestAll API option here, the application 6400 # must use the RequestTags option to generate these tags if they have not been 6401 # specifically requested. The reason is that there is too much overhead involved 6402 # in the calculation of this tag to make this worth the CPU time.) 6403 ($$self{REQ_TAG_LOOKUP}{jpegdigest} or $$self{REQ_TAG_LOOKUP}{jpegqualityestimate} 6404 or ($$options{RequestAll} and $$options{RequestAll} > 2))) 4378 6405 { 4379 6406 my $num = unpack('C',$$segDataPt) & 0x0f; # get table index … … 4382 6409 # handle all other markers 4383 6410 my $dumpType = ''; 6411 my ($desc, $tip, $xtra); 4384 6412 $length = length $$segDataPt; 6413 $appBytes += $length + 4 if ($marker & 0xf0) == 0xe0; # total size of APP segments 4385 6414 if ($verbose) { 4386 6415 print $out "JPEG $markerName ($length bytes):\n"; … … 4391 6420 } 4392 6421 } 6422 # prepare dirInfo hash for processing this information 6423 my %dirInfo = ( 6424 Parent => $markerName, 6425 DataPt => $segDataPt, 6426 DataPos => $segPos, 6427 DataLen => $length, 6428 DirStart => 0, 6429 DirLen => $length, 6430 Base => 0, 6431 ); 4393 6432 if ($marker == 0xe0) { # APP0 (JFIF, JFXX, CIFF, AVI1, Ocad) 4394 6433 if ($$segDataPt =~ /^JFIF\0/) { 4395 6434 $dumpType = 'JFIF'; 4396 my %dirInfo = ( 4397 DataPt => $segDataPt, 4398 DataPos => $segPos, 4399 DirStart => 5, 4400 DirLen => $length - 5, 4401 ); 6435 DirStart(\%dirInfo, 5); # start at byte 5 4402 6436 SetByteOrder('MM'); 4403 6437 my $tagTablePtr = GetTagTable('Image::ExifTool::JFIF::Main'); 4404 6438 $self->ProcessDirectory(\%dirInfo, $tagTablePtr); 4405 } elsif ($$segDataPt =~ /^JFXX\0\x10/) { 6439 } elsif ($$segDataPt =~ /^JFXX\0(\x10|\x11|\x13)/) { 6440 my $tag = ord $1; 4406 6441 $dumpType = 'JFXX'; 4407 6442 my $tagTablePtr = GetTagTable('Image::ExifTool::JFIF::Extension'); 4408 my $tagInfo = $self->GetTagInfo($tagTablePtr, 0x10);6443 my $tagInfo = $self->GetTagInfo($tagTablePtr, $tag); 4409 6444 $self->FoundTag($tagInfo, substr($$segDataPt, 6)); 4410 6445 } elsif ($$segDataPt =~ /^(II|MM).{4}HEAPJPGM/s) { 4411 next if $fast and $fast > 1;# skip processing for very fast6446 next if $fast > 1; # skip processing for very fast 4412 6447 $dumpType = 'CIFF'; 4413 my %dirInfo = ( 4414 RAF => new File::RandomAccess($segDataPt), 4415 ); 4416 $self->{SET_GROUP1} = 'CIFF'; 6448 my %dirInfo = ( RAF => new File::RandomAccess($segDataPt) ); 6449 $$self{SET_GROUP1} = 'CIFF'; 6450 push @{$$self{PATH}}, 'CIFF'; 4417 6451 require Image::ExifTool::CanonRaw; 4418 6452 Image::ExifTool::CanonRaw::ProcessCRW($self, \%dirInfo); 4419 delete $self->{SET_GROUP1}; 6453 pop @{$$self{PATH}}; 6454 delete $$self{SET_GROUP1}; 4420 6455 } elsif ($$segDataPt =~ /^(AVI1|Ocad)/) { 4421 6456 $dumpType = $1; 4422 6457 SetByteOrder('MM'); 4423 6458 my $tagTablePtr = GetTagTable("Image::ExifTool::JPEG::$dumpType"); 4424 my %dirInfo = ( 4425 DataPt => $segDataPt, 4426 DataPos => $segPos, 4427 DirStart => 4, 4428 DirLen => $length - 4, 4429 ); 6459 DirStart(\%dirInfo, 4); 4430 6460 $self->ProcessDirectory(\%dirInfo, $tagTablePtr); 4431 6461 } 4432 } elsif ($marker == 0xe1) { # APP1 (EXIF, XMP, QVCI) 4433 if ($$segDataPt =~ /^Exif\0/) { # (some Kodak cameras don't put a second \0) 6462 } elsif ($marker == 0xe1) { # APP1 (EXIF, XMP, QVCI, PARROT) 6463 # (some Kodak cameras don't put a second "\0", and I have seen an 6464 # example where there was a second 4-byte APP1 segment header) 6465 if ($$segDataPt =~ /^(.{0,4})Exif\0/is) { 4434 6466 undef $dumpType; # (will be dumped here) 4435 6467 # this is EXIF data -- 4436 6468 # get the data block (into a common variable) 4437 6469 my $hdrLen = length($exifAPP1hdr); 4438 my %dirInfo = ( 4439 Parent => $markerName, 4440 DataPt => $segDataPt, 4441 DataPos => $segPos, 4442 DirStart => $hdrLen, 4443 Base => $segPos + $hdrLen, 4444 ); 6470 if (length $1) { 6471 $hdrLen += length $1; 6472 $self->Warn('Unknown garbage at start of EXIF segment',1); 6473 } elsif ($$segDataPt !~ /^Exif\0/) { 6474 $self->Warn('Incorrect EXIF segment identifier',1); 6475 } 4445 6476 if ($htmlDump) { 4446 6477 $self->HDump($segPos-4, 4, 'APP1 header', "Data size: $length bytes"); … … 4448 6479 $dumpEnd = $segPos + $length; 4449 6480 } 6481 my $dataPt = $segDataPt; 6482 if (defined $combinedSegData) { 6483 push @skipData, [ $segPos-4, $segPos+$hdrLen ]; 6484 $combinedSegData .= substr($$segDataPt,$hdrLen); 6485 undef $$segDataPt; 6486 $dataPt = \$combinedSegData; 6487 $segPos = $firstSegPos; 6488 } 6489 # peek ahead to see if the next segment is extended EXIF 6490 if ($nextMarker == $marker and 6491 $$nextSegDataPt =~ /^$exifAPP1hdr(?!(MM\0\x2a|II\x2a\0))/) 6492 { 6493 # initialize combined data if necessary 6494 unless (defined $combinedSegData) { 6495 $combinedSegData = $$segDataPt; 6496 undef $$segDataPt; 6497 $firstSegPos = $segPos; 6498 $self->Warn('File contains multi-segment EXIF',1); 6499 $$self{ExtendedEXIF} = 1; 6500 } 6501 next; 6502 } 6503 $dirInfo{DataPt} = $dataPt; 6504 $dirInfo{DataPos} = $segPos; 6505 $dirInfo{DataLen} = $dirInfo{DirLen} = length $$dataPt; 6506 DirStart(\%dirInfo, $hdrLen, $hdrLen); 6507 $$self{SkipData} = \@skipData if @skipData; 4450 6508 # extract the EXIF information (it is in standard TIFF format) 4451 $self->ProcessTIFF(\%dirInfo) ;6509 $self->ProcessTIFF(\%dirInfo) or $self->Warn('Malformed APP1 EXIF segment'); 4452 6510 # avoid looking for preview unless necessary because it really slows 4453 6511 # us down -- only look for it if we found pointer, and preview is 4454 6512 # outside EXIF, and PreviewImage is specifically requested 4455 my $start = $self->GetValue('PreviewImageStart' );4456 my $ length = $self->GetValue('PreviewImageLength');4457 if (not $start or not $ lengthand $$self{PreviewError}) {6513 my $start = $self->GetValue('PreviewImageStart', 'ValueConv'); 6514 my $plen = $self->GetValue('PreviewImageLength', 'ValueConv'); 6515 if (not $start or not $plen and $$self{PreviewError}) { 4458 6516 $start = $$self{PreviewImageStart}; 4459 $length = $$self{PreviewImageLength}; 4460 } 4461 if ($start and $length and 4462 $start + $length > $self->{EXIF_POS} + length($self->{EXIF_DATA}) and 4463 $self->{REQ_TAG_LOOKUP}{previewimage}) 6517 $plen = $$self{PreviewImageLength}; 6518 } 6519 if ($start and $plen and IsInt($start) and IsInt($plen) and 6520 $start + $plen > $$self{EXIF_POS} + length($$self{EXIF_DATA}) and 6521 ($$self{REQ_TAG_LOOKUP}{previewimage} or 6522 # (extracted normally, so check Binary option) 6523 ($$options{Binary} and not $$self{EXCL_TAG_LOOKUP}{previewimage}))) 4464 6524 { 4465 6525 $$self{PreviewImageStart} = $start; 4466 $$self{PreviewImageLength} = $ length;6526 $$self{PreviewImageLength} = $plen; 4467 6527 $wantTrailer = 1; 4468 6528 } 6529 if (@skipData) { 6530 undef @skipData; 6531 delete $$self{SkipData}; 6532 } 6533 undef $$dataPt; 6534 next; 4469 6535 } elsif ($$segDataPt =~ /^$xmpExtAPP1hdr/) { 4470 6536 # off len -- extended XMP header (75 bytes total): … … 4474 6540 # 71 4 bytes - offset for this XMP data portion 4475 6541 $dumpType = 'Extended XMP'; 4476 if ( length $$segDataPt> 75) {6542 if ($length > 75) { 4477 6543 my ($size, $off) = unpack('x67N2', $$segDataPt); 4478 6544 my $guid = substr($$segDataPt, 35, 32); 4479 my $extXMP = $extendedXMP{$guid}; 4480 $extXMP or $extXMP = $extendedXMP{$guid} = { }; 4481 $$extXMP{Size} = $size; 4482 $$extXMP{$off} = substr($$segDataPt, 75); 4483 # process extended XMP if complete 4484 my @offsets; 4485 for ($off=0; $off<$size; ) { 4486 last unless defined $$extXMP{$off}; 4487 push @offsets, $off; 4488 $off += length $$extXMP{$off}; 4489 } 4490 if ($off == $size) { 4491 my $buff = ''; 4492 # assemble XMP all together 4493 $buff .= $$extXMP{$_} foreach @offsets; 4494 $dumpType = 'Extended XMP'; 4495 my $tagTablePtr = GetTagTable('Image::ExifTool::XMP::Main'); 4496 my %dirInfo = ( 4497 DataPt => \$buff, 4498 Parent => $markerName, 4499 ); 4500 $self->ProcessDirectory(\%dirInfo, $tagTablePtr); 4501 delete $extendedXMP{$guid}; 6545 if ($guid =~ /[^A-Za-z0-9]/) { # (technically, should be uppercase) 6546 $self->WarnOnce($tip = 'Invalid extended XMP GUID'); 6547 } else { 6548 my $extXMP = $extendedXMP{$guid}; 6549 if (not $extXMP) { 6550 $extXMP = $extendedXMP{$guid} = { }; 6551 } elsif ($size != $$extXMP{Size}) { 6552 $self->WarnOnce('Inconsistent extended XMP size'); 6553 } 6554 $$extXMP{Size} = $size; 6555 $$extXMP{$off} = substr($$segDataPt, 75); 6556 $tip = "Full length: $size\nChunk offset: $off\nChunk length: " . 6557 ($length - 75) . "\nGUID: $guid"; 6558 # (delay processing extended XMP until after reading all segments) 4502 6559 } 4503 6560 } else { 4504 $self->Warn ('Invalid extended XMP segment');6561 $self->WarnOnce($tip = 'Invalid extended XMP segment'); 4505 6562 } 4506 6563 } elsif ($$segDataPt =~ /^QVCI\0/) { 4507 6564 $dumpType = 'QVCI'; 4508 6565 my $tagTablePtr = GetTagTable('Image::ExifTool::Casio::QVCI'); 4509 my %dirInfo = (4510 Base => 0,4511 DataPt => $segDataPt,4512 DataPos => $segPos,4513 DataLen => $length,4514 DirStart => 0,4515 DirLen => $length,4516 Parent => $markerName,4517 );4518 6566 $self->ProcessDirectory(\%dirInfo, $tagTablePtr); 6567 } elsif ($$segDataPt =~ /^FLIR\0/ and $length >= 8) { 6568 $dumpType = 'FLIR'; 6569 # must concatenate FLIR chunks (note: handle the case where 6570 # some software erroneously writes zeros for the chunk counts) 6571 my $chunkNum = Get8u($segDataPt, 6); 6572 my $chunksTot = Get8u($segDataPt, 7) + 1; # (note the "+ 1"!) 6573 $verbose and printf $out "$$self{INDENT}FLIR chunk %d of %d\n", 6574 $chunkNum + 1, $chunksTot; 6575 if (defined $flirTotal) { 6576 # abort parsing FLIR if the total chunk count is inconsistent 6577 undef $flirCount if $chunksTot != $flirTotal; 6578 } else { 6579 $flirCount = 0; 6580 $flirTotal = $chunksTot; 6581 } 6582 if (defined $flirCount) { 6583 if (defined $flirChunk[$chunkNum]) { 6584 $self->WarnOnce('Duplicate FLIR chunk number(s)'); 6585 $flirChunk[$chunkNum] .= substr($$segDataPt, 8); 6586 } else { 6587 $flirChunk[$chunkNum] = substr($$segDataPt, 8); 6588 } 6589 # process the FLIR information if we have all of the chunks 6590 if (++$flirCount >= $flirTotal) { 6591 my $flir = ''; 6592 defined $_ and $flir .= $_ foreach @flirChunk; 6593 undef @flirChunk; # free memory 6594 my $tagTablePtr = GetTagTable('Image::ExifTool::FLIR::FFF'); 6595 my %dirInfo = ( 6596 DataPt => \$flir, 6597 Parent => $markerName, 6598 DirName => 'FLIR', 6599 ); 6600 $self->ProcessDirectory(\%dirInfo, $tagTablePtr); 6601 undef $flirCount; # prevent reprocessing 6602 } 6603 } else { 6604 $self->WarnOnce('Invalid or extraneous FLIR chunk(s)'); 6605 } 6606 } elsif ($$segDataPt =~ /^PARROT\0(II\x2a\0|MM\0\x2a)/) { 6607 # (don't know if this could span multiple segments) 6608 my $tagTablePtr = GetTagTable('Image::ExifTool::JPEG::Main'); 6609 $self->HandleTag($tagTablePtr, 'APP1', $$segDataPt); 6610 $dumpType = 'Parrot'; 4519 6611 } else { 4520 6612 # Hmmm. Could be XMP, let's see 4521 6613 my $processed; 4522 if ($$segDataPt =~ /^ http/ or $$segDataPt =~ /<exif:/) {6614 if ($$segDataPt =~ /^(http|XMP\0)/ or $$segDataPt =~ /<(exif:|\?xpacket)/) { 4523 6615 $dumpType = 'XMP'; 4524 6616 # also try to parse XMP with a non-standard header … … 4526 6618 my $start = ($$segDataPt =~ /^$xmpAPP1hdr/) ? length($xmpAPP1hdr) : 0; 4527 6619 my $tagTablePtr = GetTagTable('Image::ExifTool::XMP::Main'); 4528 my %dirInfo = ( 4529 Base => 0, 4530 DataPt => $segDataPt, 4531 DataPos => $segPos, 4532 DataLen => $length, 4533 DirStart => $start, 4534 DirLen => $length - $start, 4535 Parent => $markerName, 4536 ); 6620 DirStart(\%dirInfo, $start); 6621 $dirInfo{DirName} = $start ? 'XMP' : 'XML', 4537 6622 $processed = $self->ProcessDirectory(\%dirInfo, $tagTablePtr); 4538 6623 if ($processed and not $start) { … … 4541 6626 } 4542 6627 if ($verbose and not $processed) { 4543 $self->Warn("Ignored EXIF block length $length (badheader)");6628 $self->Warn("Ignored APP1 segment length $length (unknown header)"); 4544 6629 } 4545 6630 } 4546 6631 } elsif ($marker == 0xe2) { # APP2 (ICC Profile, FPXR, MPF, PreviewImage) 4547 if ($$segDataPt =~ /^ICC_PROFILE\0/ ) {6632 if ($$segDataPt =~ /^ICC_PROFILE\0/ and $length >= 14) { 4548 6633 $dumpType = 'ICC_Profile'; 4549 # must concatenate blocks of profile 4550 my $block_num = Get8u($segDataPt, 12); 4551 my $blocks_tot = Get8u($segDataPt, 13); 4552 $icc_profile = '' if $block_num == 1; 4553 if (defined $icc_profile) { 4554 $icc_profile .= substr($$segDataPt, 14); 4555 if ($block_num == $blocks_tot) { 6634 # must concatenate profile chunks (note: handle the case where 6635 # some software erroneously writes zeros for the chunk counts) 6636 my $chunkNum = Get8u($segDataPt, 12); 6637 my $chunksTot = Get8u($segDataPt, 13); 6638 $verbose and print $out "$$self{INDENT}ICC_Profile chunk $chunkNum of $chunksTot\n"; 6639 if (defined $iccChunksTotal) { 6640 # abort parsing ICC_Profile if the total chunk count is inconsistent 6641 undef $iccChunkCount if $chunksTot != $iccChunksTotal; 6642 } else { 6643 $iccChunkCount = 0; 6644 $iccChunksTotal = $chunksTot; 6645 $self->Warn('ICC_Profile chunk count is zero') if !$chunksTot; 6646 } 6647 if (defined $iccChunkCount) { 6648 if (defined $iccChunk[$chunkNum]) { 6649 $self->WarnOnce('Duplicate ICC_Profile chunk number(s)'); 6650 $iccChunk[$chunkNum] .= substr($$segDataPt, 14); 6651 } else { 6652 $iccChunk[$chunkNum] = substr($$segDataPt, 14); 6653 } 6654 # process profile if we have all of the chunks 6655 if (++$iccChunkCount >= $iccChunksTotal) { 6656 my $icc_profile = ''; 6657 defined $_ and $icc_profile .= $_ foreach @iccChunk; 6658 undef @iccChunk; # free memory 4556 6659 my $tagTablePtr = GetTagTable('Image::ExifTool::ICC_Profile::Main'); 4557 6660 my %dirInfo = ( … … 4564 6667 ); 4565 6668 $self->ProcessDirectory(\%dirInfo, $tagTablePtr); 4566 undef $icc _profile;6669 undef $iccChunkCount; # prevent reprocessing 4567 6670 } 6671 } else { 6672 $self->WarnOnce('Invalid or extraneous ICC_Profile chunk(s)'); 4568 6673 } 4569 6674 } elsif ($$segDataPt =~ /^FPXR\0/) { 4570 next if $fast and $fast > 1;# skip processing for very fast6675 next if $fast > 1; # skip processing for very fast 4571 6676 $dumpType = 'FPXR'; 4572 6677 my $tagTablePtr = GetTagTable('Image::ExifTool::FlashPix::Main'); 4573 my %dirInfo = ( 4574 DataPt => $segDataPt, 4575 DataPos => $segPos, 4576 DataLen => $length, 4577 DirStart => 0, 4578 DirLen => $length, 4579 Parent => $markerName, 4580 # set flag if this is the last FPXR segment 4581 LastFPXR => not ($nextMarker==$marker and $$nextSegDataPt=~/^FPXR\0/), 4582 ); 6678 # set flag if this is the last FPXR segment 6679 $dirInfo{LastFPXR} = not ($nextMarker==$marker and $$nextSegDataPt=~/^FPXR\0/), 4583 6680 $self->ProcessDirectory(\%dirInfo, $tagTablePtr); 4584 6681 } elsif ($$segDataPt =~ /^MPF\0/) { 4585 6682 undef $dumpType; # (will be dumped here) 4586 my %dirInfo = ( 4587 Parent => $markerName, 4588 DataPt => $segDataPt, 4589 DataPos => $segPos, 4590 DirStart => 4, 4591 Base => $segPos + 4, 4592 Multi => 1, # the MP Attribute IFD will be MPF1 4593 ); 6683 DirStart(\%dirInfo, 4, 4); 6684 $dirInfo{Multi} = 1; # the MP Attribute IFD will be MPF1 4594 6685 if ($htmlDump) { 4595 6686 $self->HDump($segPos-4, 4, 'APP2 header', "Data size: $length bytes"); … … 4600 6691 my $tagTablePtr = GetTagTable('Image::ExifTool::MPF::Main'); 4601 6692 $self->ProcessTIFF(\%dirInfo, $tagTablePtr); 4602 } elsif ($$segDataPt =~ /^\xff\xd8\xff\xdb/) { 4603 $preview = $$segDataPt; 4604 $dumpType = 'Samsung Preview'; 6693 } elsif ($$segDataPt =~ /^(|QVGA\0|BGTH)\xff\xd8\xff[\xdb\xe0\xe1]/) { 6694 # Samsung/GE/GoPro="", BenQ DC C1220/Pentacon/Polaroid="QVGA\0", 6695 # Digilife DDC-690/Rollei="BGTH" 6696 $dumpType = 'Preview Image'; 6697 $preview = substr($$segDataPt, length($1)); 4605 6698 } elsif ($preview) { 6699 $dumpType = 'Preview Image'; 4606 6700 $preview .= $$segDataPt; 4607 $dumpType = 'Samsung Preview';4608 6701 } 4609 6702 if ($preview and $nextMarker ne $marker) { … … 4614 6707 if ($$segDataPt =~ /^(Meta|META|Exif)\0\0/) { 4615 6708 undef $dumpType; # (will be dumped here) 4616 my %dirInfo = ( 4617 Parent => $markerName, 4618 DataPt => $segDataPt, 4619 DataPos => $segPos, 4620 DirStart => 6, 4621 Base => $segPos + 6, 4622 ); 6709 DirStart(\%dirInfo, 6, 6); 4623 6710 if ($htmlDump) { 4624 6711 $self->HDump($segPos-4, 10, 'APP3 Meta header'); … … 4629 6716 } elsif ($$segDataPt =~ /^Stim\0/) { 4630 6717 undef $dumpType; # (will be dumped here) 4631 my %dirInfo = ( 4632 Parent => $markerName, 4633 DataPt => $segDataPt, 4634 DataPos => $segPos, 4635 DirStart => 6, 4636 Base => $segPos + 6, 4637 ); 6718 DirStart(\%dirInfo, 6, 6); 4638 6719 if ($htmlDump) { 4639 6720 $self->HDump($segPos-4, 4, 'APP3 header', "Data size: $length bytes"); … … 4644 6725 my $tagTablePtr = GetTagTable('Image::ExifTool::Stim::Main'); 4645 6726 $self->ProcessTIFF(\%dirInfo, $tagTablePtr); 6727 } elsif ($$self{Make} eq 'DJI') { 6728 $dumpType = 'DJI ThermalData'; 6729 # add this data to the combined data if it exists 6730 my $dataPt = $segDataPt; 6731 if (defined $combinedSegData) { 6732 $combinedSegData .= $$segDataPt; 6733 $dataPt = \$combinedSegData; 6734 } 6735 if ($nextMarker == $marker) { 6736 $combinedSegData = $$segDataPt unless defined $combinedSegData; 6737 } else { 6738 # process DJI FLIR thermal data 6739 my $tagTablePtr = GetTagTable('Image::ExifTool::JPEG::Main'); 6740 $self->HandleTag($tagTablePtr, 'APP3', $$dataPt); 6741 undef $combinedSegData; 6742 } 4646 6743 } elsif ($$segDataPt =~ /^\xff\xd8\xff\xdb/) { 6744 $dumpType = 'PreviewImage'; # (Samsung, HP, BenQ) 4647 6745 $preview = $$segDataPt; 4648 $dumpType = 'Samsung/HP Preview'; 4649 } 4650 # Samsung continues the preview in APP4 4651 if ($preview and $nextMarker ne 0xe4) { 6746 } 6747 if ($preview and $nextMarker ne 0xe4) { # this preview continues in APP4 4652 6748 $self->FoundTag('PreviewImage', $preview); 4653 6749 undef $preview; … … 4668 6764 DataPt => \$scalado, 4669 6765 ); 4670 my $tagTablePtr = GetTagTable('Image::ExifTool:: JPEG::Scalado');6766 my $tagTablePtr = GetTagTable('Image::ExifTool::Scalado::Main'); 4671 6767 $self->ProcessDirectory(\%dirInfo, $tagTablePtr); 4672 6768 undef $scalado; 4673 6769 } 4674 6770 } elsif ($$segDataPt =~ /^FPXR\0/) { 4675 next if $fast and $fast > 1;# skip processing for very fast6771 next if $fast > 1; # skip processing for very fast 4676 6772 $dumpType = 'FPXR'; 4677 6773 my $tagTablePtr = GetTagTable('Image::ExifTool::FlashPix::Main'); 4678 my %dirInfo = ( 4679 DataPt => $segDataPt, 4680 DataPos => $segPos, 4681 DataLen => $length, 4682 DirStart => 0, 4683 DirLen => $length, 4684 Parent => $markerName, 4685 # set flag if this is the last FPXR segment 4686 LastFPXR => not ($nextMarker==$marker and $$nextSegDataPt=~/^FPXR\0/), 4687 ); 6774 # set flag if this is the last FPXR segment 6775 $dirInfo{LastFPXR} = not ($nextMarker==$marker and $$nextSegDataPt=~/^FPXR\0/), 6776 $self->ProcessDirectory(\%dirInfo, $tagTablePtr); 6777 } elsif ($$self{Make} eq 'DJI' and $$segDataPt =~ /^\xaa\x55\x12\x06/) { 6778 $dumpType = 'DJI ThermalParams'; 6779 DirStart(\%dirInfo, 0, 0); 6780 my $tagTablePtr = GetTagTable('Image::ExifTool::DJI::ThermalParams'); 4688 6781 $self->ProcessDirectory(\%dirInfo, $tagTablePtr); 4689 6782 } elsif ($preview) { 4690 6783 # continued Samsung S1060 preview from APP3 6784 $dumpType = 'PreviewImage'; 4691 6785 $preview .= $$segDataPt; 4692 # (not sure if next part would be APP5 or APP4 again, but assume APP4) 4693 if ($nextMarker ne $marker) { 4694 $self->FoundTag('PreviewImage', $preview); 4695 undef $preview; 4696 } 6786 } 6787 # (also seen "QTI Debug Metadata\0" segment in some newer Samsung images) 6788 # BenQ DC E1050 continues preview in APP5 6789 if ($preview and $nextMarker ne 0xe5) { 6790 $self->FoundTag('PreviewImage', $preview); 6791 undef $preview; 4697 6792 } 4698 6793 } elsif ($marker == 0xe5) { # APP5 (Ricoh "RMETA") 4699 6794 if ($$segDataPt =~ /^RMETA\0/) { 6795 # (NOTE: apparently these may span multiple segments, but I haven't seen 6796 # a sample like this, so multi-segment support hasn't yet been implemented) 4700 6797 $dumpType = 'Ricoh RMETA'; 4701 my %dirInfo = ( 4702 Parent => $markerName, 4703 DataPt => $segDataPt, 4704 DataPos => $segPos, 4705 DirStart => 6, 4706 Base => $segPos + 6, 4707 ); 6798 DirStart(\%dirInfo, 6, 6); 4708 6799 my $tagTablePtr = GetTagTable('Image::ExifTool::Ricoh::RMETA'); 4709 6800 $self->ProcessDirectory(\%dirInfo, $tagTablePtr); 6801 } elsif ($$segDataPt =~ /^ssuniqueid\0/) { 6802 my $tagTablePtr = GetTagTable('Image::ExifTool::Samsung::APP5'); 6803 $self->HandleTag($tagTablePtr, 'ssuniqueid', substr($$segDataPt, 11)); 6804 } elsif ($$self{Make} eq 'DJI') { 6805 $dumpType = 'DJI ThermalCal'; 6806 my $tagTablePtr = GetTagTable('Image::ExifTool::JPEG::Main'); 6807 $self->HandleTag($tagTablePtr, 'APP5', $$segDataPt); 6808 } elsif ($preview) { 6809 $dumpType = 'PreviewImage'; 6810 $preview .= $$segDataPt; 6811 $self->FoundTag('PreviewImage', $preview); 6812 undef $preview; 4710 6813 } 4711 6814 } elsif ($marker == 0xe6) { # APP6 (Toshiba EPPIM, NITF, HP_TDHD) 4712 6815 if ($$segDataPt =~ /^EPPIM\0/) { 4713 6816 undef $dumpType; # (will be dumped here) 4714 my %dirInfo = ( 4715 Parent => $markerName, 4716 DataPt => $segDataPt, 4717 DataPos => $segPos, 4718 DirStart => 6, 4719 Base => $segPos + 6, 4720 ); 6817 DirStart(\%dirInfo, 6, 6); 4721 6818 if ($htmlDump) { 4722 6819 $self->HDump($segPos-4, 10, 'APP6 EPPIM header'); … … 4729 6826 SetByteOrder('MM'); 4730 6827 my $tagTablePtr = GetTagTable('Image::ExifTool::JPEG::NITF'); 4731 my %dirInfo = ( 4732 DataPt => $segDataPt, 4733 DataPos => $segPos, 4734 DirStart => 5, 4735 DirLen => $length - 5, 4736 ); 6828 DirStart(\%dirInfo, 5); 4737 6829 $self->ProcessDirectory(\%dirInfo, $tagTablePtr); 4738 6830 } elsif ($$segDataPt =~ /^TDHD\x01\0\0\0/ and $length > 12) { … … 4740 6832 $dumpType = 'TDHD'; 4741 6833 my $tagTablePtr = GetTagTable('Image::ExifTool::HP::TDHD'); 4742 my %dirInfo = ( 4743 DataPt => $segDataPt, 4744 DataPos => $segPos, 4745 DirStart => 12, # (ignore first TDHD element because size includes 12-byte tag header) 4746 DirLen => $length - 12, 4747 ); 6834 # (ignore first TDHD element because size includes 12-byte tag header) 6835 DirStart(\%dirInfo, 12); 6836 $self->ProcessDirectory(\%dirInfo, $tagTablePtr); 6837 } elsif ($$segDataPt =~ /^GoPro\0/) { 6838 # GoPro segment 6839 $dumpType = 'GoPro'; 6840 my $tagTablePtr = GetTagTable('Image::ExifTool::GoPro::GPMF'); 6841 DirStart(\%dirInfo, 6); 6842 $self->ProcessDirectory(\%dirInfo, $tagTablePtr); 6843 } elsif ($$segDataPt =~ /^DTAT\0\0.\{/s) { 6844 $dumpType = 'DJI_DTAT'; 6845 my $tagTablePtr = GetTagTable('Image::ExifTool::JPEG::Main'); 6846 $self->HandleTag($tagTablePtr, 'APP6', $$segDataPt); 6847 } 6848 } elsif ($marker == 0xe7) { # APP7 (Pentax, Huawei, Qualcomm) 6849 if ($$segDataPt =~ /^PENTAX \0(II|MM)/) { 6850 # found in K-3 images (is this multi-segment??) 6851 SetByteOrder($1); 6852 undef $dumpType; # (dump this ourself) 6853 my $hdrLen = 10; 6854 my $tagTablePtr = GetTagTable('Image::ExifTool::Pentax::Main'); 6855 DirStart(\%dirInfo, $hdrLen, 0); 6856 $dirInfo{DirName} = 'Pentax APP7'; 6857 if ($htmlDump) { 6858 $self->HDump($segPos-4, 4, 'APP7 header', "Data size: $length bytes"); 6859 $self->HDump($segPos, $hdrLen, 'Pentax header', 'APP7 data type: Pentax'); 6860 $dumpEnd = $segPos + $length; 6861 } 6862 $self->ProcessDirectory(\%dirInfo, $tagTablePtr); 6863 } elsif ($$segDataPt =~ /^HUAWEI\0\0(II|MM)/) { 6864 SetByteOrder($1); 6865 undef $dumpType; # (dump this ourself) 6866 my $hdrLen = 16; 6867 my $tagTablePtr = GetTagTable('Image::ExifTool::Unknown::Main'); 6868 DirStart(\%dirInfo, $hdrLen, 8); 6869 $dirInfo{DirName} = 'Huawei APP7'; 6870 if ($htmlDump) { 6871 $self->HDump($segPos-4, 4, 'APP7 header', "Data size: $length bytes"); 6872 $self->HDump($segPos, $hdrLen, 'Huawei header', 'APP7 data type: Huawei'); 6873 $dumpEnd = $segPos + $length; 6874 } 6875 $$self{SET_GROUP0} = 'APP7'; 6876 $$self{SET_GROUP1} = 'Huawei'; 6877 $self->ProcessDirectory(\%dirInfo, $tagTablePtr); 6878 delete $$self{SET_GROUP0}; 6879 delete $$self{SET_GROUP1}; 6880 } elsif ($$segDataPt =~ /^\x1aQualcomm Camera Attributes/) { 6881 # found in HP iPAQ_VoiceMessenger 6882 $dumpType = 'Qualcomm'; 6883 my $tagTablePtr = GetTagTable('Image::ExifTool::Qualcomm::Main'); 6884 DirStart(\%dirInfo, 27); 6885 $dirInfo{DirName} = 'Qualcomm'; 4748 6886 $self->ProcessDirectory(\%dirInfo, $tagTablePtr); 4749 6887 } … … 4752 6890 if ($$segDataPt =~ /^SPIFF\0/ and $length == 32) { 4753 6891 $dumpType = 'SPIFF'; 4754 my %dirInfo = ( 4755 DataPt => $segDataPt, 4756 DataPos => $segPos, 4757 DirStart => 6, 4758 DirLen => $length - 6, 4759 ); 6892 DirStart(\%dirInfo, 6); 4760 6893 my $tagTablePtr = GetTagTable('Image::ExifTool::JPEG::SPIFF'); 4761 6894 $self->ProcessDirectory(\%dirInfo, $tagTablePtr); 6895 } 6896 } elsif ($marker == 0xe9) { # APP9 (Media Jukebox) 6897 if ($$segDataPt =~ /^Media Jukebox\0/ and $length > 22) { 6898 $dumpType = 'MediaJukebox'; 6899 # (start parsing after the "<MJMD>") 6900 DirStart(\%dirInfo, 22); 6901 $dirInfo{DirName} = 'MediaJukebox'; 6902 require Image::ExifTool::XMP; 6903 my $tagTablePtr = GetTagTable('Image::ExifTool::JPEG::MediaJukebox'); 6904 $self->ProcessDirectory(\%dirInfo, $tagTablePtr, \&Image::ExifTool::XMP::ProcessXMP); 4762 6905 } 4763 6906 } elsif ($marker == 0xea) { # APP10 (PhotoStudio Unicode comments) … … 4766 6909 my $comment = $self->Decode(substr($$segDataPt,8), 'UCS2', 'MM'); 4767 6910 $self->FoundTag('Comment', $comment); 6911 } elsif ($$segDataPt =~ /^AROT\0/ and $length > 10) { 6912 # iPhone "AROT" segment containing integrated intensity per 16 scan lines 6913 # (with number of elements N = ImageHeight / 16 - 1, ref PH/NealKrawetz) 6914 $xtra = 'segment (N=' . unpack('x6N', $$segDataPt) . ')'; 6915 } 6916 } elsif ($marker == 0xeb) { # APP11 (JPEG-HDR) 6917 if ($$segDataPt =~ /^HDR_RI /) { 6918 $dumpType = 'JPEG-HDR'; 6919 my $dataPt = $segDataPt; 6920 if (defined $combinedSegData) { 6921 if ($$segDataPt =~ /~\0/g) { 6922 $combinedSegData .= substr($$segDataPt,pos($$segDataPt)); 6923 } else { 6924 $self->Warn('Invalid format for JPEG-HDR extended segment'); 6925 } 6926 $dataPt = \$combinedSegData; 6927 } 6928 if ($nextMarker == $marker and $$nextSegDataPt =~ /^HDR_RI /) { 6929 $combinedSegData = $$segDataPt unless defined $combinedSegData; 6930 } else { 6931 my $tagTablePtr = GetTagTable('Image::ExifTool::JPEG::HDR'); 6932 my %dirInfo = ( DataPt => $dataPt ); 6933 $self->ProcessDirectory(\%dirInfo, $tagTablePtr); 6934 undef $combinedSegData; 6935 } 4768 6936 } 4769 6937 } elsif ($marker == 0xec) { # APP12 (Ducky, Picture Info) 4770 6938 if ($$segDataPt =~ /^Ducky/) { 4771 6939 $dumpType = 'Ducky'; 4772 my %dirInfo = ( 4773 DataPt => $segDataPt, 4774 DataPos => $segPos, 4775 DirStart => 5, 4776 DirLen => $length - 5, 4777 ); 6940 DirStart(\%dirInfo, 5); 4778 6941 my $tagTablePtr = GetTagTable('Image::ExifTool::APP12::Ducky'); 4779 6942 $self->ProcessDirectory(\%dirInfo, $tagTablePtr); 4780 6943 } else { 4781 my %dirInfo = ( DataPt => $segDataPt );4782 6944 my $tagTablePtr = GetTagTable('Image::ExifTool::APP12::PictureInfo'); 4783 6945 $self->ProcessDirectory(\%dirInfo, $tagTablePtr) and $dumpType = 'Picture Info'; … … 4799 6961 # (will handle the Photoshop data the next time around) 4800 6962 } else { 4801 my $hdr len = $isOld ? 27 : 14;6963 my $hdrLen = $isOld ? 27 : 14; 4802 6964 # process APP13 Photoshop record 4803 6965 my $tagTablePtr = GetTagTable('Image::ExifTool::Photoshop::Main'); … … 4806 6968 DataPos => $segPos, 4807 6969 DataLen => length $$dataPt, 4808 DirStart => $hdr len, # directory starts after identifier4809 DirLen => length($$dataPt) - $hdr len,6970 DirStart => $hdrLen, # directory starts after identifier 6971 DirLen => length($$dataPt) - $hdrLen, 4810 6972 Parent => $markerName, 4811 6973 ); … … 4817 6979 SetByteOrder('MM'); 4818 6980 my $tagTablePtr = GetTagTable('Image::ExifTool::JPEG::AdobeCM'); 4819 my %dirInfo = ( 4820 DataPt => $segDataPt, 4821 DataPos => $segPos, 4822 DirStart => 8, 4823 DirLen => $length - 8, 4824 ); 6981 DirStart(\%dirInfo, 8); 4825 6982 $self->ProcessDirectory(\%dirInfo, $tagTablePtr); 4826 6983 } 4827 6984 } elsif ($marker == 0xee) { # APP14 (Adobe) 4828 6985 if ($$segDataPt =~ /^Adobe/) { 6986 # extract as a block if requested, or if copying tags from file 6987 if ($$self{REQ_TAG_LOOKUP}{adobe} or 6988 # (not extracted normally, so check TAGS_FROM_FILE) 6989 ($$self{TAGS_FROM_FILE} and not $$self{EXCL_TAG_LOOKUP}{adobe})) 6990 { 6991 $self->FoundTag('Adobe', $$segDataPt); 6992 } 4829 6993 $dumpType = 'Adobe'; 4830 6994 SetByteOrder('MM'); 4831 6995 my $tagTablePtr = GetTagTable('Image::ExifTool::JPEG::Adobe'); 4832 my %dirInfo = ( 4833 DataPt => $segDataPt, 4834 DataPos => $segPos, 4835 DirStart => 5, 4836 DirLen => $length - 5, 4837 ); 6996 DirStart(\%dirInfo, 5); 4838 6997 $self->ProcessDirectory(\%dirInfo, $tagTablePtr); 4839 6998 } … … 4848 7007 $$segDataPt =~ s/\0+$//; # some dumb softwares add null terminators 4849 7008 $self->FoundTag('Comment', $$segDataPt); 7009 } elsif ($marker == 0x64) { # CME (J2C comment and extension) 7010 $dumpType = 'Comment'; 7011 if ($length > 2) { 7012 my $reg = unpack('n', $$segDataPt); # get registration value 7013 my $val = substr($$segDataPt, 2); 7014 $val = $self->Decode($val, 'Latin') if $reg == 1; 7015 # (actually an extension for $reg==65535, but store as binary comment) 7016 $self->FoundTag('Comment', ($reg==0 or $reg==65535) ? \$val : $val); 7017 } 7018 } elsif ($marker == 0x51) { # SIZ (J2C) 7019 my ($w, $h) = unpack('x2N2', $$segDataPt); 7020 $self->FoundTag('ImageWidth', $w); 7021 $self->FoundTag('ImageHeight', $h); 4850 7022 } elsif (($marker & 0xf0) != 0xe0) { 4851 undef $dumpType; # only dump unknown APP segments 7023 $dumpType = "$markerName segment"; 7024 $desc = "[JPEG $markerName]"; # (other known JPEG segments) 4852 7025 } 4853 7026 if (defined $dumpType) { 4854 if (not $dumpType and $self->{OPTIONS}{Unknown}) { 4855 $self->Warn("Unknown $markerName segment", 1); 7027 if (not $dumpType and ($$options{Unknown} or $$options{Validate})) { 7028 my $str = ($$segDataPt =~ /^([\x20-\x7e]{1,20})\0/) ? " '${1}'" : ''; 7029 $xtra = 'segment' unless $xtra; 7030 $self->Warn("Unknown $markerName$str $xtra", 1); 4856 7031 } 4857 7032 if ($htmlDump) { 4858 my$desc = $markerName . ($dumpType ? " $dumpType" : '') . ' segment';4859 $self->HDump($segPos-4, $length+4, $desc, undef, 0x08);7033 $desc or $desc = $markerName . ($dumpType ? " $dumpType" : '') . ' segment'; 7034 $self->HDump($segPos-4, $length+4, $desc, $tip, 0x08); 4860 7035 $dumpEnd = $segPos + $length; 4861 7036 } … … 4863 7038 undef $$segDataPt; 4864 7039 } 7040 # process extended XMP now if it existed 7041 if (%extendedXMP) { 7042 my $guid; 7043 # GUID indicated by the last main XMP segment 7044 my $goodGuid = $$self{VALUE}{HasExtendedXMP} || ''; 7045 # GUID of the extended XMP that we will process ('2' for all) 7046 my $readGuid = $$options{ExtendedXMP} || 0; 7047 $readGuid = $goodGuid if $readGuid eq '1'; 7048 foreach $guid (sort keys %extendedXMP) { 7049 next unless length $guid == 32; # ignore other (internal) keys 7050 my $extXMP = $extendedXMP{$guid}; 7051 my ($off, @offsets, $warn); 7052 # make sure we have all chunks, and create a list of sorted offsets 7053 for ($off=0; $off<$$extXMP{Size}; ) { 7054 last unless defined $$extXMP{$off}; 7055 push @offsets, $off; 7056 $off += length $$extXMP{$off}; 7057 } 7058 unless ($off == $$extXMP{Size}) { 7059 $self->Warn("Incomplete extended XMP (GUID $guid)"); 7060 next; 7061 } 7062 if ($guid eq $readGuid or $readGuid eq '2') { 7063 $warn = 'Reading non-' if $guid ne $goodGuid; 7064 my $buff = ''; 7065 # assemble XMP all together 7066 $buff .= $$extXMP{$_} foreach @offsets; 7067 my $tagTablePtr = GetTagTable('Image::ExifTool::XMP::Main'); 7068 my %dirInfo = ( 7069 DataPt => \$buff, 7070 Parent => 'APP1', 7071 IsExtended => 1, 7072 ); 7073 $$path[$pn] = 'APP1'; 7074 $self->ProcessDirectory(\%dirInfo, $tagTablePtr); 7075 pop @$path; 7076 } else { 7077 $warn = 'Ignored '; 7078 $warn .= 'non-' if $guid ne $goodGuid; 7079 } 7080 $self->Warn("${warn}standard extended XMP (GUID $guid)") if $warn; 7081 delete $extendedXMP{$guid}; 7082 } 7083 } 4865 7084 # calculate JPEGDigest if requested 4866 if (@dqt and $subSampling) {7085 if (@dqt) { 4867 7086 require Image::ExifTool::JPEGDigest; 4868 7087 Image::ExifTool::JPEGDigest::Calculate($self, \@dqt, $subSampling); 4869 7088 } 7089 # issue necessary warnings 7090 $self->Warn('Incomplete ICC_Profile record', 1) if defined $iccChunkCount; 7091 $self->Warn('Incomplete FLIR record', 1) if defined $flirCount; 4870 7092 $self->Warn('Error reading PreviewImage', 1) if $$self{PreviewError}; 4871 $self->Warn('Invalid extended XMP') if %extendedXMP;4872 7093 $success or $self->Warn('JPEG format error'); 4873 7094 pop @$path if @$path > $pn; 4874 7095 return 1; 7096 } 7097 7098 #------------------------------------------------------------------------------ 7099 # Extract metadata from an Exiv2 EXV file 7100 # Inputs: 0) ExifTool object reference, 1) dirInfo ref with RAF set 7101 # Returns: 1 on success, 0 if this wasn't a valid JPEG file 7102 sub ProcessEXV($$) 7103 { 7104 my ($self, $dirInfo) = @_; 7105 return $self->ProcessJPEG($dirInfo); 4875 7106 } 4876 7107 … … 4914 7145 my $base = $$dirInfo{Base} || 0; 4915 7146 my $outfile = $$dirInfo{OutFile}; 4916 my ($err, $ canonSig, $otherSig);7147 my ($err, $sig, $canonSig, $otherSig); 4917 7148 4918 7149 # attempt to read TIFF header 4919 $ self->{EXIF_DATA} = '';7150 $$self{EXIF_DATA} = ''; 4920 7151 if ($raf) { 4921 7152 if ($outfile) { … … 4930 7161 # extract full EXIF block (for block copy) from EXIF file 4931 7162 my $amount = $fileType eq 'EXIF' ? 65536 * 8 : 8; 4932 my $n = $raf->Read($ self->{EXIF_DATA}, $amount);7163 my $n = $raf->Read($$self{EXIF_DATA}, $amount); 4933 7164 if ($n < 8) { 4934 7165 return 0 if $n or not $outfile or $fileType ne 'EXIF'; 4935 7166 # create EXIF file from scratch 4936 delete $ self->{EXIF_DATA};7167 delete $$self{EXIF_DATA}; 4937 7168 undef $raf; 4938 7169 } … … 4940 7171 $raf->Seek(8, 0); 4941 7172 if ($n == $amount) { 4942 $ self->{EXIF_DATA} = substr($self->{EXIF_DATA}, 0, 8);7173 $$self{EXIF_DATA} = substr($$self{EXIF_DATA}, 0, 8); 4943 7174 $self->Warn('EXIF too large to extract as a block'); #(shouldn't happen) 4944 7175 } … … 4948 7179 my $dirStart = $$dirInfo{DirStart} || 0; 4949 7180 my $dirLen = $$dirInfo{DirLen} || (length($$dataPt) - $dirStart); 4950 $ self->{EXIF_DATA} = substr($$dataPt, $dirStart, $dirLen);4951 $self->VerboseDir('TIFF') if $ self->{OPTIONS}{Verbose} and length($$self{INDENT}) > 2;7181 $$self{EXIF_DATA} = substr($$dataPt, $dirStart, $dirLen); 7182 $self->VerboseDir('TIFF') if $$self{OPTIONS}{Verbose} and length($$self{INDENT}) > 2; 4952 7183 } elsif ($outfile) { 4953 delete $ self->{EXIF_DATA}; # create from scratch7184 delete $$self{EXIF_DATA}; # create from scratch 4954 7185 } else { 4955 $self->{EXIF_DATA} = ''; 4956 } 4957 unless (defined $self->{EXIF_DATA}) { 7186 $$self{EXIF_DATA} = ''; 7187 } 7188 unless (defined $$self{EXIF_DATA}) { 7189 # set default byte order for creating new GPS in CR3 images 7190 my $defaultByteOrder; 7191 if ($$dirInfo{DirName} and $$dirInfo{DirName} eq 'GPS') { 7192 $defaultByteOrder = $$self{SaveExifByteOrder}; 7193 } 4958 7194 # create TIFF information from scratch 4959 if ($self->SetPreferredByteOrder( ) eq 'MM') {4960 $ self->{EXIF_DATA} = "MM\0\x2a\0\0\0\x08";7195 if ($self->SetPreferredByteOrder($defaultByteOrder) eq 'MM') { 7196 $$self{EXIF_DATA} = "MM\0\x2a\0\0\0\x08"; 4961 7197 } else { 4962 $self->{EXIF_DATA} = "II\x2a\0\x08\0\0\0"; 4963 } 4964 } 4965 $$self{FIRST_EXIF_POS} = $base + $$self{BASE} unless defined $$self{FIRST_EXIF_POS}; 7198 $$self{EXIF_DATA} = "II\x2a\0\x08\0\0\0"; 7199 } 7200 } 4966 7201 $$self{EXIF_POS} = $base + $$self{BASE}; 4967 $dataPt = \$self->{EXIF_DATA}; 7202 $$self{FIRST_EXIF_POS} = $$self{EXIF_POS} unless defined $$self{FIRST_EXIF_POS}; 7203 $dataPt = \$$self{EXIF_DATA}; 4968 7204 4969 7205 # set byte ordering … … 4977 7213 # (TIFF=0x2a, RW2/RWL=0x55, HDP=0xbc, BTF=0x2b, ORF=0x4f52/0x5352/0x????) 4978 7214 # return 0 unless $identifier == 0x2a; 7215 $self->Warn('Invalid magic number in EXIF TIFF header') if $fileType eq 'APP1' and $identifier != 0x2a; 4979 7216 4980 7217 # get offset to IFD0 7218 return 0 if length $$dataPt < 8; 4981 7219 my $offset = Get32u($dataPt, 4); 4982 7220 $offset >= 8 or return 0; 4983 7221 4984 7222 if ($raf) { 4985 # Canon CR2 images usually have an offset of 16, but it may be 4986 # greater if edited by PhotoMechanic, so check the 4-byte signature 7223 # check for canon or EXIF signature 7224 # (Canon CR2 images should have an offset of 16, but it may be 7225 # greater if edited by PhotoMechanic) 4987 7226 if ($identifier == 0x2a and $offset >= 16) { 4988 $raf->Read($canonSig, 8) == 8 or return 0; 4989 $$dataPt .= $canonSig; 4990 if ($canonSig =~ /^(CR\x02\0|\xba\xb0\xac\xbb)/) { 4991 $fileType = $canonSig =~ /^CR/ ? 'CR2' : 'Canon 1D RAW'; 4992 $self->HDump($base+8, 8, "[$fileType header]") if $self->{HTML_DUMP}; 4993 } else { 4994 undef $canonSig; 7227 $raf->Read($sig, 8) == 8 or return 0; 7228 $$dataPt .= $sig; 7229 if ($sig =~ /^(CR\x02\0|\xba\xb0\xac\xbb|ExifMeta)/) { 7230 if ($sig eq 'ExifMeta') { 7231 $self->SetFileType($fileType = 'EXIF'); 7232 $otherSig = $sig; 7233 } else { 7234 $fileType = $sig =~ /^CR/ ? 'CR2' : 'Canon 1D RAW'; 7235 $canonSig = $sig; 7236 } 7237 $self->HDump($base+8, 8, "[$fileType header]") if $$self{HTML_DUMP}; 4995 7238 } 4996 7239 } elsif ($identifier == 0x55 and $fileType =~ /^(RAW|RW2|RWL|TIFF)$/) { … … 5008 7251 } 5009 7252 $tagTablePtr = GetTagTable('Image::ExifTool::PanasonicRaw::Main'); 5010 } elsif ($identifier == 0x2b and $fileType eq 'TIFF') { 5011 # this looks like a BigTIFF image 5012 $raf->Seek(0); 5013 require Image::ExifTool::BigTIFF; 5014 return 1 if Image::ExifTool::BigTIFF::ProcessBTF($self, $dirInfo); 5015 } elsif (Get8u($dataPt, 2) == 0xbc and $byteOrder eq 'II' and $fileType eq 'TIFF') { 5016 $fileType = 'HDP'; # Windows HD Photo file 5017 # check version number 5018 my $ver = Get8u($dataPt, 3); 5019 if ($ver > 1) { 5020 $self->Error("Windows HD Photo version $ver files not yet supported"); 5021 return 1; 5022 } 5023 } elsif ($identifier == 0x4352 and $fileType eq 'TIFF') { 5024 $fileType = 'DCP'; 7253 } elsif ($fileType eq 'TIFF') { 7254 if ($identifier == 0x2b) { 7255 # this looks like a BigTIFF image 7256 $raf->Seek(0); 7257 require Image::ExifTool::BigTIFF; 7258 return 1 if Image::ExifTool::BigTIFF::ProcessBTF($self, $dirInfo); 7259 } elsif ($identifier == 0x4f52 or $identifier == 0x5352) { 7260 # Olympus ORF image (set FileType now because base type is 'ORF') 7261 $self->SetFileType($fileType = 'ORF'); 7262 } elsif ($identifier == 0x4352) { 7263 $fileType = 'DCP'; 7264 } elsif ($byteOrder eq 'II' and ($identifier & 0xff) == 0xbc) { 7265 $fileType = 'HDP'; # Windows HD Photo file 7266 # check version number 7267 my $ver = Get8u($dataPt, 3); 7268 if ($ver > 1) { 7269 $self->Error("Windows HD Photo version $ver files not yet supported"); 7270 return 1; 7271 } 7272 } 5025 7273 } 5026 7274 # we have a valid TIFF (or whatever) file 5027 if ($fileType and not $ self->{VALUE}{FileType}) {7275 if ($fileType and not $$self{VALUE}{FileType}) { 5028 7276 my $lookup = $fileTypeLookup{$fileType}; 5029 7277 $lookup = $fileTypeLookup{$lookup} unless ref $lookup or not $lookup; 5030 7278 # use file extension to pre-determine type if extension is TIFF-based or type is RAW 5031 my $t = (($lookup and $$lookup[0] eq 'TIFF') or $fileType =~ /RAW/) ? $fileType : undef; 7279 my $baseType = $lookup ? (ref $$lookup[0] ? $$lookup[0][0] : $$lookup[0]) : ''; 7280 my $t = ($baseType eq 'TIFF' or $fileType =~ /RAW/) ? $fileType : undef; 5032 7281 $self->SetFileType($t); 5033 7282 } 5034 } 5035 my $ifdName = 'IFD0'; 7283 # don't process file if FastScan == 3 7284 return 1 if not $outfile and $$self{OPTIONS}{FastScan} and $$self{OPTIONS}{FastScan} == 3; 7285 } 7286 # (accommodate CR3 images which have a TIFF directory with ExifIFD at the top level) 7287 my $ifdName = ($$dirInfo{DirName} and $$dirInfo{DirName} =~ /^(ExifIFD|GPS)$/) ? $1 : 'IFD0'; 5036 7288 if (not $tagTablePtr or $$tagTablePtr{GROUPS}{0} eq 'EXIF') { 5037 $self->FoundTag('ExifByteOrder', $byteOrder); 7289 $self->FoundTag('ExifByteOrder', $byteOrder) unless $outfile; 7290 } elsif ($$tagTablePtr{GROUPS}{0} eq 'MakerNotes') { # (for writing CR3 maker notes) 7291 $ifdName = $$tagTablePtr{GROUPS}{0}; 5038 7292 } else { 5039 7293 $ifdName = $$tagTablePtr{GROUPS}{1}; 5040 7294 } 5041 if ($ self->{HTML_DUMP}) {7295 if ($$self{HTML_DUMP}) { 5042 7296 my $tip = sprintf("Byte order: %s endian\nIdentifier: 0x%.4x\n$ifdName offset: 0x%.4x", 5043 7297 ($byteOrder eq 'II') ? 'Little' : 'Big', $identifier, $offset); … … 5045 7299 } 5046 7300 # remember where we found the TIFF data (APP1, APP3, TIFF, NEF, etc...) 5047 $ self->{TIFF_TYPE} = $fileType;7301 $$self{TIFF_TYPE} = $fileType; 5048 7302 5049 7303 # get reference to the main EXIF table … … 5070 7324 $self->ProcessDirectory(\%dirInfo, $tagTablePtr); 5071 7325 # process GeoTiff information if available 5072 if ($ self->{VALUE}{GeoTiffDirectory}) {7326 if ($$self{VALUE}{GeoTiffDirectory}) { 5073 7327 require Image::ExifTool::GeoTiff; 5074 7328 Image::ExifTool::GeoTiff::ProcessGeoTiff($self); … … 5081 7335 $self->ProcessTrailers($trailInfo); 5082 7336 } 5083 # dump any other known trailer ( ie. A100 RAW Data)7337 # dump any other known trailer (eg. A100 RAW Data) 5084 7338 if ($$self{HTML_DUMP} and $$self{KnownTrailer}) { 5085 7339 my $known = $$self{KnownTrailer}; … … 5091 7345 } 5092 7346 # update FileType if necessary now that we know more about the file 5093 if ($$self{DNGVersion} and $ self->{VALUE}{FileType} ne 'DNG') {7347 if ($$self{DNGVersion} and $$self{VALUE}{FileType} !~ /^(DNG|GPR)$/) { 5094 7348 # override whatever FileType we set since we now know it is DNG 5095 $self->OverrideFileType( 'DNG');7349 $self->OverrideFileType($$self{TIFF_TYPE} = 'DNG'); 5096 7350 } 5097 7351 return 1; … … 5101 7355 # 5102 7356 if ($$dirInfo{NoTiffEnd}) { 5103 delete $ self->{TIFF_END};7357 delete $$self{TIFF_END}; 5104 7358 } else { 5105 7359 # initialize TIFF_END so it will be updated by WriteExif() 5106 $ self->{TIFF_END} = 0;7360 $$self{TIFF_END} = 0; 5107 7361 } 5108 7362 if ($canonSig) { … … 5114 7368 } else { 5115 7369 # write TIFF header (8 bytes [plus optional signature] followed by IFD) 5116 $otherSig = '' unless defined $otherSig; 7370 if ($fileType eq 'EXIF') { 7371 $otherSig = 'ExifMeta'; # force this signature for all EXIF files 7372 } elsif (not defined $otherSig) { 7373 $otherSig = ''; 7374 } 5117 7375 my $offset = 8 + length($otherSig); 5118 7376 # construct tiff header … … 5138 7396 # write any required ARW trailer and patch other ARW quirks 5139 7397 require Image::ExifTool::Sony; 5140 my $errStr = Image::ExifTool::Sony::FinishARW($self, $dirInfo, \$newData, 7398 my $errStr = Image::ExifTool::Sony::FinishARW($self, $dirInfo, \$newData, 5141 7399 $dirInfo{ImageData}); 5142 7400 $errStr and $self->Error($errStr); … … 5154 7412 } 5155 7413 # make local copy of TIFF_END now (it may be reset when processing trailers) 5156 my $tiffEnd = $ self->{TIFF_END};5157 delete $ self->{TIFF_END};7414 my $tiffEnd = $$self{TIFF_END}; 7415 delete $$self{TIFF_END}; 5158 7416 5159 7417 # rewrite trailers if they exist … … 5189 7447 if ($extra > 0) { 5190 7448 my $known = $$self{KnownTrailer}; 5191 if ($ self->{DEL_GROUP}{Trailer} and not $known) {7449 if ($$self{DEL_GROUP}{Trailer} and not $known) { 5192 7450 $self->VPrint(0, " Deleting unknown trailer ($extra bytes)\n"); 5193 ++$ self->{CHANGED};7451 ++$$self{CHANGED}; 5194 7452 } elsif ($known) { 5195 7453 $self->VPrint(0, " Copying $$known{Name} ($extra bytes)\n"); … … 5228 7486 if ($$self{DNGVersion}) { 5229 7487 my $ver = $$self{DNGVersion}; 5230 # currently support up to DNG version 1. 25231 unless ($ver =~ /^(\d+) (\d+)/ and "$1.$2" <= 1. 3) {7488 # currently support up to DNG version 1.5 7489 unless ($ver =~ /^(\d+) (\d+)/ and "$1.$2" <= 1.5) { 5232 7490 $ver =~ tr/ /./; 5233 $self->Error("DNG Version $ver not yet supported", 1);7491 $self->Error("DNG Version $ver not yet tested", 1); 5234 7492 } 5235 7493 } … … 5276 7534 my $module = $1; 5277 7535 if (eval "require $module") { 5278 # load additional XMP modules if required 5279 if (not %$tableName and $module eq 'Image::ExifTool::XMP') { 5280 require 'Image/ExifTool/XMP2.pl'; 7536 # load additional modules if required 7537 if (not %$tableName) { 7538 if ($module eq 'Image::ExifTool::XMP') { 7539 require 'Image/ExifTool/XMP2.pl'; 7540 } elsif ($tableName eq 'Image::ExifTool::QuickTime::Stream') { 7541 require 'Image/ExifTool/QuickTimeStream.pl'; 7542 } 5281 7543 } 5282 7544 } else { … … 5292 7554 $table = \%$tableName; 5293 7555 use strict 'refs'; 7556 &{$$table{INIT_TABLE}}($table) if $$table{INIT_TABLE}; 5294 7557 $$table{TABLE_NAME} = $tableName; # set table name 5295 7558 ($$table{SHORT_NAME} = $tableName) =~ s/^Image::ExifTool:://; … … 5317 7580 } 5318 7581 # generate a tag prefix for unknown tags if necessary 5319 unless ( $$table{TAG_PREFIX}) {7582 unless (defined $$table{TAG_PREFIX}) { 5320 7583 my $tagPrefix; 5321 7584 if ($tableName =~ /Image::.*?::(.*)::Main/ || $tableName =~ /Image::.*?::(.*)/) { … … 5328 7591 # set up the new table 5329 7592 SetupTagTable($table); 5330 # add any user-defined tags 5331 if (%UserDefined and $UserDefined{$tableName} ) {7593 # add any user-defined tags (except Composite tags, which are handled specially) 7594 if (%UserDefined and $UserDefined{$tableName} and $table ne \%Image::ExifTool::Composite) { 5332 7595 my $tagID; 5333 7596 foreach $tagID (TagTableKeys($UserDefined{$tableName})) { 5334 my $tagInfo = $UserDefined{$tableName}{$tagID}; 5335 if (ref $tagInfo eq 'HASH') { 5336 $$tagInfo{Name} or $$tagInfo{Name} = ucfirst($tagID); 5337 } else { 5338 $tagInfo = { Name => $tagInfo }; 5339 } 5340 if ($$table{WRITABLE} and not defined $$tagInfo{Writable} and 5341 not $$tagInfo{SubDirectory}) 5342 { 5343 $$tagInfo{Writable} = $$table{WRITABLE}; 5344 } 7597 next if $specialTags{$tagID}; 5345 7598 delete $$table{$tagID}; # replace any existing entry 5346 AddTagToTable($table, $tagID, $ tagInfo);7599 AddTagToTable($table, $tagID, $UserDefined{$tableName}{$tagID}, 1); 5347 7600 } 5348 7601 } … … 5351 7604 # insert newly loaded table into list 5352 7605 $allTables{$tableName} = $table; 7606 } 7607 # must check each time to add UserDefined Composite tags because the Composite table 7608 # may be loaded before the UserDefined tags are available 7609 if ($table eq \%Image::ExifTool::Composite and not $$table{VARS}{LOADED_USERDEFINED} and 7610 %UserDefined and $UserDefined{$tableName}) 7611 { 7612 my $userComp = $UserDefined{$tableName}; 7613 delete $UserDefined{$tableName}; # (must delete first to avoid infinite recursion) 7614 AddCompositeTags($userComp, 1); 7615 $UserDefined{$tableName} = $userComp; # (add back again for adding writable tags later) 7616 $$table{VARS}{LOADED_USERDEFINED} = 1; # set flag to avoid doing this again 5353 7617 } 5354 7618 return $table; … … 5368 7632 $proc or $proc = $$tagTablePtr{PROCESS_PROC} || \&Image::ExifTool::Exif::ProcessExif; 5369 7633 # set directory name from default group0 name if not done already 5370 $$dirInfo{DirName} or $$dirInfo{DirName} = $tagTablePtr->{GROUPS}{0}; 7634 my $dirName = $$dirInfo{DirName}; 7635 unless ($dirName) { 7636 $dirName = $$tagTablePtr{GROUPS}{0}; 7637 $dirName = $$tagTablePtr{GROUPS}{1} if $dirName =~ /^APP\d+$/; # (use specific APP name) 7638 $$dirInfo{DirName} = $dirName; 7639 } 7640 5371 7641 # guard against cyclical recursion into the same directory 5372 if (defined $$dirInfo{DirStart} and defined $$dirInfo{DataPos}) { 5373 my $addr = $$dirInfo{DirStart} + $$dirInfo{DataPos} + ($$dirInfo{Base}||0); 5374 if ($self->{PROCESSED}{$addr}) { 5375 $self->Warn("$$dirInfo{DirName} pointer references previous $self->{PROCESSED}{$addr} directory"); 5376 return 0; 5377 } 5378 $self->{PROCESSED}{$addr} = $$dirInfo{DirName}; 7642 if (defined $$dirInfo{DirStart} and defined $$dirInfo{DataPos} and 7643 # directories don't overlap if the length is zero 7644 ($$dirInfo{DirLen} or not defined $$dirInfo{DirLen})) 7645 { 7646 my $addr = $$dirInfo{DirStart} + $$dirInfo{DataPos} + ($$dirInfo{Base}||0) + $$self{BASE}; 7647 if ($$self{PROCESSED}{$addr}) { 7648 $self->Warn("$dirName pointer references previous $$self{PROCESSED}{$addr} directory"); 7649 # patch for bug in Windows phone 7.5 O/S that writes incorrect InteropIFD pointer 7650 return 0 unless $dirName eq 'GPS' and $$self{PROCESSED}{$addr} eq 'InteropIFD'; 7651 } 7652 $$self{PROCESSED}{$addr} = $dirName; 5379 7653 } 5380 7654 my $oldOrder = GetByteOrder(); 5381 my $oldIndent = $self->{INDENT};5382 my $oldDir = $self->{DIR_NAME};5383 $ self->{LIST_TAGS} = { }; # don't build lists across different directories5384 $ self->{INDENT} .= '| ';5385 $self->{DIR_NAME} = $$dirInfo{DirName};5386 push @{$self->{PATH}}, $$dirInfo{DirName};7655 my @save = @$self{'INDENT','DIR_NAME','Compression','SubfileType'}; 7656 $$self{LIST_TAGS} = { }; # don't build lists across different directories 7657 $$self{INDENT} .= '| '; 7658 $$self{DIR_NAME} = $dirName; 7659 push @{$$self{PATH}}, $dirName; 7660 $$self{FOUND_DIR}{$dirName} = 1; 5387 7661 5388 7662 # process the directory 7663 no strict 'refs'; 5389 7664 my $rtnVal = &$proc($self, $dirInfo, $tagTablePtr); 5390 5391 pop @{$self->{PATH}}; 5392 $self->{INDENT} = $oldIndent;5393 $self->{DIR_NAME} = $oldDir;7665 use strict 'refs'; 7666 7667 pop @{$$self{PATH}}; 7668 @$self{'INDENT','DIR_NAME','Compression','SubfileType'} = @save; 5394 7669 SetByteOrder($oldOrder); 5395 7670 return $rtnVal; … … 5398 7673 #------------------------------------------------------------------------------ 5399 7674 # Get Metadata path 5400 # Inputs: 0) Exif tool object ref7675 # Inputs: 0) ExifTool object ref 5401 7676 # Return: Metadata path string 5402 7677 sub MetadataPath($) … … 5414 7689 my $filename = shift; 5415 7690 my $fileExt; 5416 if ($filename and $filename =~ / .*\.(.+)$/) {7691 if ($filename and $filename =~ /^.*\.([^.]+)$/s) { 5417 7692 $fileExt = uc($1); # change extension to upper case 5418 7693 # convert TIF extension to TIFF because we use the … … 5433 7708 my $tagInfo = $$tagTablePtr{$tagID}; 5434 7709 5435 if (ref $tagInfo eq 'HASH') { 7710 if ($specialTags{$tagID}) { 7711 # (hopefully this won't happen) 7712 warn "Tag $tagID conflicts with internal ExifTool variable in $$tagTablePtr{TABLE_NAME}\n"; 7713 } elsif (ref $tagInfo eq 'HASH') { 5436 7714 return ($tagInfo); 5437 7715 } elsif (ref $tagInfo eq 'ARRAY') { … … 5477 7755 } 5478 7756 } 5479 if ($$tagInfo{Unknown} and not $$self{OPTIONS}{Unknown} and not $$self{OPTIONS}{Verbose}) { 7757 if ($$tagInfo{Unknown} and not $$self{OPTIONS}{Unknown} and 7758 not $$self{OPTIONS}{Verbose} and not $$self{HTML_DUMP}) 7759 { 5480 7760 # don't return Unknown tags unless that option is set 5481 7761 return undef; … … 5515 7795 # Add new tag to table (must use this routine to add new tags to a table) 5516 7796 # Inputs: 0) reference to tag table, 1) tag ID 5517 # 2) [optional] reference to tag information hash 5518 # Notes: - will not overwrite existing entry in table 7797 # 2) [optional] tag name or reference to tag information hash 7798 # 3) [optional] flag to avoid adding prefix when generating tag name 7799 # Returns: tagInfo ref 7800 # Notes: - will not override existing entry in table 5519 7801 # - info need contain no entries when this routine is called 5520 sub AddTagToTable($$;$) 5521 { 5522 my ($tagTablePtr, $tagID, $tagInfo) = @_; 5523 $tagInfo or $tagInfo = { }; 7802 # - tag name is cleaned if necessary 7803 sub AddTagToTable($$;$$) 7804 { 7805 my ($tagTablePtr, $tagID, $tagInfo, $noPrefix) = @_; 7806 7807 # generate tag info hash if necessary 7808 $tagInfo = $tagInfo ? { Name => $tagInfo } : { } unless ref $tagInfo eq 'HASH'; 5524 7809 5525 7810 # define necessary entries in information hash … … 5527 7812 # fill in default groups from table GROUPS 5528 7813 foreach (keys %{$$tagTablePtr{GROUPS}}) { 5529 next if $ tagInfo->{Groups}{$_};5530 $ tagInfo->{Groups}{$_} = $tagTablePtr->{GROUPS}{$_};7814 next if $$tagInfo{Groups}{$_}; 7815 $$tagInfo{Groups}{$_} = $$tagTablePtr{GROUPS}{$_}; 5531 7816 } 5532 7817 } else { … … 5537 7822 $$tagInfo{Table} = $tagTablePtr; 5538 7823 $$tagInfo{TagID} = $tagID; 7824 if (defined $$tagTablePtr{AVOID} and not defined $$tagInfo{Avoid}) { 7825 $$tagInfo{Avoid} = $$tagTablePtr{AVOID}; 7826 } 5539 7827 5540 7828 my $name = $$tagInfo{Name}; 5541 if (defined $name) { 5542 $name =~ tr/-_a-zA-Z0-9//dc; # remove illegal characters 5543 } else { 5544 # construct a name from the tag ID 5545 $name = $tagID; 5546 $name =~ tr/-_a-zA-Z0-9//dc; # remove illegal characters 5547 $name = ucfirst $name; # start with uppercase 5548 # make sure name is a reasonable length 5549 my $prefix = $$tagTablePtr{TAG_PREFIX}; 5550 if ($prefix) { 5551 # make description to prevent tagID from getting mangled by MakeDescription() 5552 $$tagInfo{Description} = MakeDescription($prefix, $name); 5553 $name = "${prefix}_$name"; 5554 } 5555 } 5556 # tag names must be at least 2 characters long and begin with a letter 5557 $name = "Tag$name" if length($name) <= 1 or $name !~ /^[A-Z]/i; 7829 $name = $tagID unless defined $name; 7830 $name =~ tr/-_a-zA-Z0-9//dc; # remove illegal characters 7831 $name = ucfirst $name; # capitalize first letter 7832 # add tag-name prefix if specified and tag name not provided 7833 unless (defined $$tagInfo{Name} or $noPrefix or not $$tagTablePtr{TAG_PREFIX}) { 7834 # make description to prevent tagID from getting mangled by MakeDescription() 7835 $$tagInfo{Description} = MakeDescription($$tagTablePtr{TAG_PREFIX}, $name); 7836 $name = "$$tagTablePtr{TAG_PREFIX}_$name"; 7837 } 7838 # tag names must be at least 2 characters long and prefer them to start with a letter 7839 $name = "Tag$name" if length($name) < 2 or $name !~ /^[A-Z]/i; 5558 7840 $$tagInfo{Name} = $name; 5559 # add tag to table, but never over write existing entries (could potentially happen7841 # add tag to table, but never override existing entries (could potentially happen 5560 7842 # if someone thinks there isn't any tagInfo because a condition wasn't satisfied) 5561 $$tagTablePtr{$tagID} = $tagInfo unless defined $$tagTablePtr{$tagID}; 7843 unless (defined $$tagTablePtr{$tagID} or $specialTags{$tagID}) { 7844 $$tagTablePtr{$tagID} = $tagInfo; 7845 } 7846 return $tagInfo; 5562 7847 } 5563 7848 … … 5565 7850 # Handle simple extraction of new tag information 5566 7851 # Inputs: 0) ExifTool object ref, 1) tag table reference, 2) tagID, 3) value, 5567 # 4-N) parameters hash: Index, DataPt, DataPos, Start, Size, Parent,5568 # TagInfo, ProcessProc, RAF 7852 # 4-N) parameters hash: Index, DataPt, DataPos, Base, Start, Size, Parent, 7853 # TagInfo, ProcessProc, RAF, Format, Count 5569 7854 # Returns: tag key or undef if tag not found 5570 7855 # Notes: if value is not defined, it is extracted from DataPt using TagInfo … … 5573 7858 { 5574 7859 my ($self, $tagTablePtr, $tag, $val, %parms) = @_; 5575 my $verbose = $self->{OPTIONS}{Verbose}; 5576 my $tagInfo = $parms{TagInfo} || $self->GetTagInfo($tagTablePtr, $tag, \$val); 7860 my $verbose = $$self{OPTIONS}{Verbose}; 7861 my $pfmt = $parms{Format}; 7862 my $tagInfo = $parms{TagInfo} || $self->GetTagInfo($tagTablePtr, $tag, \$val, $pfmt, $parms{Count}); 5577 7863 my $dataPt = $parms{DataPt}; 5578 my ($subdir, $format, $ count, $size, $noTagInfo);7864 my ($subdir, $format, $noTagInfo, $rational); 5579 7865 5580 7866 if ($tagInfo) { 5581 $subdir = $$tagInfo{SubDirectory} 7867 $subdir = $$tagInfo{SubDirectory}; 5582 7868 } else { 5583 7869 return undef unless $verbose; … … 5586 7872 } 5587 7873 # read value if not done already (not necessary for subdir) 5588 unless (defined $val or ($subdir and not $$tagInfo{Writable} )) {7874 unless (defined $val or ($subdir and not $$tagInfo{Writable} and not $$tagInfo{RawConv})) { 5589 7875 my $start = $parms{Start} || 0; 5590 my $size = $parms{Size} || 0; 7876 my $dLen = $dataPt ? length($$dataPt) : -1; 7877 my $size = $parms{Size}; 7878 $size = $dLen unless defined $size; 5591 7879 # read from data in memory if possible 5592 if ($ dataPt and $start >= 0 and $start + $size <= length($$dataPt)) {7880 if ($start >= 0 and $start + $size <= $dLen) { 5593 7881 $format = $$tagInfo{Format} || $$tagTablePtr{FORMAT}; 7882 $format = $pfmt if not $format and $pfmt and $formatSize{$pfmt}; 5594 7883 if ($format) { 5595 $val = ReadValue($dataPt, $start, $format, $$tagInfo{Count}, $size );7884 $val = ReadValue($dataPt, $start, $format, $$tagInfo{Count}, $size, \$rational); 5596 7885 } else { 5597 7886 $val = substr($$dataPt, $start, $size); … … 5606 7895 undef $tagInfo if $noTagInfo; 5607 7896 $parms{Value} = $val; 7897 $parms{Value} .= " ($rational)" if defined $rational; 5608 7898 $parms{Table} = $tagTablePtr; 5609 7899 if ($format) { 5610 $count or$count = int(($parms{Size} || 0) / ($formatSize{$format} || 1));7900 my $count = int(($parms{Size} || 0) / ($formatSize{$format} || 1)); 5611 7901 $parms{Format} = $format . "[$count]"; 5612 7902 } … … 5617 7907 my $subdirStart = $parms{Start}; 5618 7908 my $subdirLen = $parms{Size}; 7909 if ($$tagInfo{RawConv} and not $$tagInfo{Writable}) { 7910 my $conv = $$tagInfo{RawConv}; 7911 local $SIG{'__WARN__'} = \&SetWarning; 7912 undef $evalWarning; 7913 if (ref $conv eq 'CODE') { 7914 $val = &$conv($val, $self); 7915 } else { 7916 my ($priority, @grps); 7917 # NOTE: RawConv is evaluated in Writer.pl and twice in ExifTool.pm 7918 #### eval RawConv ($self, $val, $tag, $tagInfo, $priority, @grps) 7919 $val = eval $conv; 7920 $@ and $evalWarning = $@; 7921 } 7922 $self->Warn("RawConv $tag: " . CleanWarning()) if $evalWarning; 7923 return undef unless defined $val; 7924 $val = $$val if ref $val eq 'SCALAR'; 7925 $dataPt = \$val; 7926 $subdirStart = 0; 7927 $subdirLen = length $val; 7928 } 5619 7929 if ($$subdir{Start}) { 5620 7930 my $valuePtr = 0; 5621 7931 #### eval Start ($valuePtr) 5622 my $off = eval $$subdir{Start}; 7932 my $off = eval $$subdir{Start}; 5623 7933 $subdirStart += $off; 5624 7934 $subdirLen -= $off; … … 5640 7950 ); 5641 7951 my $oldOrder = GetByteOrder(); 5642 SetByteOrder($$subdir{ByteOrder}) if $$subdir{ByteOrder}; 7952 if ($$subdir{ByteOrder}) { 7953 if ($$subdir{ByteOrder} eq 'Unknown') { 7954 if ($subdirStart + 2 <= $subdirLen) { 7955 # attempt to determine the byte ordering of an IFD-style subdirectory 7956 my $num = Get16u($dataPt, $subdirStart); 7957 ToggleByteOrder if $num & 0xff00 and ($num>>8) > ($num&0xff); 7958 } 7959 } else { 7960 SetByteOrder($$subdir{ByteOrder}); 7961 } 7962 } 5643 7963 my $subTablePtr = GetTagTable($$subdir{TagTable}) || $tagTablePtr; 5644 7964 $self->ProcessDirectory(\%dirInfo, $subTablePtr, $$subdir{ProcessProc} || $parms{ProcessProc}); … … 5647 7967 return undef unless $$tagInfo{Writable}; 5648 7968 } 5649 return $self->FoundTag($tagInfo, $val); 7969 my $key = $self->FoundTag($tagInfo, $val); 7970 # save original components of rational numbers 7971 $$self{RATIONAL}{$key} = $rational if defined $rational and defined $key; 7972 return $key; 5650 7973 } 5651 7974 return undef; … … 5657 7980 # 1) reference to tagInfo hash or tag name 5658 7981 # 2) data value (or reference to require hash if Composite) 7982 # 3) optional family 0 group, 4) optional family 1 group 5659 7983 # Returns: tag key or undef if no value 5660 sub FoundTag($$$ )7984 sub FoundTag($$$;@) 5661 7985 { 5662 7986 local $_; 5663 my ($self, $tagInfo, $value) = @_; 5664 my $tag; 7987 my ($self, $tagInfo, $value, @grps) = @_; 7988 my ($tag, $noListDel); 7989 my $options = $$self{OPTIONS}; 5665 7990 5666 7991 if (ref $tagInfo eq 'HASH') { … … 5673 7998 # (not advised to do this since the tag won't show in list) 5674 7999 $tagInfo or $tagInfo = { Name => $tag, Groups => \%allGroupsExifTool }; 5675 $self->{OPTIONS}{Verbose} and $self->VerboseInfo(undef, $tagInfo, Value => $value); 5676 } 5677 my $rawValueHash = $self->{VALUE}; 8000 $$options{Verbose} and $self->VerboseInfo(undef, $tagInfo, Value => $value); 8001 } 8002 # get tag priority 8003 my $priority = $$tagInfo{Priority}; 8004 unless (defined $priority) { 8005 $priority = $$tagInfo{Table}{PRIORITY}; 8006 $priority = 0 if not defined $priority and $$tagInfo{Avoid}; 8007 } 8008 $grps[0] or $grps[0] = $$self{SET_GROUP0}; 8009 $grps[1] or $grps[1] = $$self{SET_GROUP1}; 8010 my $valueHash = $$self{VALUE}; 8011 5678 8012 if ($$tagInfo{RawConv}) { 5679 8013 # initialize @val for use in Composite RawConv expressions 5680 8014 my @val; 5681 if (ref $value eq 'HASH' ) {5682 foreach (keys %$value) { $val[$_] = $$ rawValueHash{$$value{$_}}; }8015 if (ref $value eq 'HASH' and $$tagInfo{IsComposite}) { 8016 foreach (keys %$value) { $val[$_] = $$valueHash{$$value{$_}}; } 5683 8017 } 5684 8018 my $conv = $$tagInfo{RawConv}; … … 5687 8021 if (ref $conv eq 'CODE') { 5688 8022 $value = &$conv($value, $self); 8023 $$self{grps} and @grps = @{$$self{grps}}, delete $$self{grps}; 5689 8024 } else { 5690 my $val = $value; # must do this in case eval references$val8025 my $val = $value; # do this so eval can use $val 5691 8026 # NOTE: RawConv is also evaluated in Writer.pl 5692 #### eval RawConv ($self, $val, $tag, $tagInfo )8027 #### eval RawConv ($self, $val, $tag, $tagInfo, $priority, @grps) 5693 8028 $value = eval $conv; 5694 8029 $@ and $evalWarning = $@; … … 5697 8032 return undef unless defined $value; 5698 8033 } 5699 # get tag priority5700 my $priority = $$tagInfo{Priority};5701 defined $priority or $priority = $tagInfo->{Table}{PRIORITY};5702 8034 # handle duplicate tag names 5703 if (defined $$ rawValueHash{$tag}) {8035 if (defined $$valueHash{$tag}) { 5704 8036 # add to list if there is an active list for this tag 5705 if ($self->{LIST_TAGS}{$tagInfo}) { 5706 $tag = $self->{LIST_TAGS}{$tagInfo}; # use key from previous list tag 5707 if (ref $$rawValueHash{$tag} ne 'ARRAY') { 5708 $$rawValueHash{$tag} = [ $$rawValueHash{$tag} ]; 5709 } 5710 push @{$$rawValueHash{$tag}}, $value; 5711 return $tag; # return without creating a new entry 8037 if ($$self{LIST_TAGS}{$tagInfo}) { 8038 $tag = $$self{LIST_TAGS}{$tagInfo}; # use key from previous list tag 8039 if (defined $$self{NO_LIST}) { 8040 # accumulate list in TAG_EXTRA "NoList" element 8041 if (defined $$self{TAG_EXTRA}{$tag}{NoList}) { 8042 push @{$$self{TAG_EXTRA}{$tag}{NoList}}, $value; 8043 } else { 8044 $$self{TAG_EXTRA}{$tag}{NoList} = [ $$valueHash{$tag}, $value ]; 8045 } 8046 $noListDel = 1; # set flag to delete this tag if re-listed 8047 } else { 8048 if (ref $$valueHash{$tag} ne 'ARRAY') { 8049 $$valueHash{$tag} = [ $$valueHash{$tag} ]; 8050 } 8051 push @{$$valueHash{$tag}}, $value; 8052 return $tag; # return without creating a new entry 8053 } 5712 8054 } 5713 8055 # get next available tag key 5714 my $nextInd = $ self->{DUPL_TAG}{$tag} = ($self->{DUPL_TAG}{$tag} || 0) + 1;8056 my $nextInd = $$self{DUPL_TAG}{$tag} = ($$self{DUPL_TAG}{$tag} || 0) + 1; 5715 8057 my $nextTag = "$tag ($nextInd)"; 5716 8058 # … … 5718 8060 # 5719 8061 # promote existing 0-priority tag so it takes precedence over a new 0-tag 5720 # (unless old tag was a sub-document and new tag isn't) 5721 my $oldPriority = $self->{PRIORITY}{$tag}; 8062 # (unless old tag was a sub-document and new tag isn't. Also, never override 8063 # a Warning tag because they may be added by ValueConv, which could be confusing) 8064 my $oldPriority = $$self{PRIORITY}{$tag}; 5722 8065 unless ($oldPriority) { 5723 if ($ self->{DOC_NUM} or not $self->{TAG_EXTRA}{$tag}or5724 not $self->{TAG_EXTRA}{$tag}{G3})8066 if ($$self{DOC_NUM} or not $$self{TAG_EXTRA}{$tag} or $tag eq 'Warning' or 8067 not $$self{TAG_EXTRA}{$tag}{G3}) 5725 8068 { 5726 8069 $oldPriority = 1; … … 5734 8077 $priority = 1 if not $priority and $$self{DIR_NAME} and 5735 8078 $$self{DIR_NAME} eq $$self{PRIORITY_DIR}; 5736 } elsif ($$self{DIR_NAME} and $$self{LOW_PRIORITY_DIR}{$$self{DIR_NAME}}) { 8079 } elsif ($$self{LOW_PRIORITY_DIR}{'*'} or 8080 ($$self{DIR_NAME} and $$self{LOW_PRIORITY_DIR}{$$self{DIR_NAME}})) 8081 { 5737 8082 $priority = 0; # default is 0 for a LOW_PRIORITY_DIR 5738 8083 } else { 5739 8084 $priority = 1; # the normal default 5740 8085 } 5741 if ($priority >= $oldPriority and not $self->{DOC_NUM}) { 8086 if ($priority >= $oldPriority and (not $$self{DOC_NUM} or 8087 ($$self{TAG_EXTRA}{$tag} and $$self{TAG_EXTRA}{$tag}{G3} and 8088 $$self{DOC_NUM} eq $$self{TAG_EXTRA}{$tag}{G3})) and not $noListDel) 8089 { 5742 8090 # move existing tag out of the way since this tag is higher priority 5743 $self->{MOVED_KEY} = $nextTag; # used in BuildCompositeTags() 5744 $self->{PRIORITY}{$nextTag} = $self->{PRIORITY}{$tag}; 5745 $$rawValueHash{$nextTag} = $$rawValueHash{$tag}; 5746 $self->{FILE_ORDER}{$nextTag} = $self->{FILE_ORDER}{$tag}; 5747 my $oldInfo = $self->{TAG_INFO}{$nextTag} = $self->{TAG_INFO}{$tag}; 5748 if ($self->{TAG_EXTRA}{$tag}) { 5749 $self->{TAG_EXTRA}{$nextTag} = $self->{TAG_EXTRA}{$tag}; 5750 delete $self->{TAG_EXTRA}{$tag}; 5751 } 8091 # (NOTE: any new members added here must also be added to DeleteTag()) 8092 $$self{PRIORITY}{$nextTag} = $$self{PRIORITY}{$tag}; 8093 $$valueHash{$nextTag} = $$valueHash{$tag}; 8094 $$self{FILE_ORDER}{$nextTag} = $$self{FILE_ORDER}{$tag}; 8095 my $oldInfo = $$self{TAG_INFO}{$nextTag} = $$self{TAG_INFO}{$tag}; 8096 foreach ('TAG_EXTRA','RATIONAL') { 8097 if ($$self{$_}{$tag}) { 8098 $$self{$_}{$nextTag} = $$self{$_}{$tag}; 8099 delete $$self{$_}{$tag}; 8100 } 8101 } 8102 delete $$self{BOTH}{$tag}; 5752 8103 # update tag key for list if necessary 5753 $self->{LIST_TAGS}{$oldInfo} = $nextTag if $self->{LIST_TAGS}{$oldInfo}; 8104 $$self{LIST_TAGS}{$oldInfo} = $nextTag if $$self{LIST_TAGS}{$oldInfo}; 8105 # update this key if used in a Composite tag 8106 if ($$self{COMP_KEYS}{$tag}) { 8107 $$_[0]{$$_[1]} = $nextTag foreach @{$$self{COMP_KEYS}{$tag}}; 8108 $$self{COMP_KEYS}{$nextTag} = $$self{COMP_KEYS}{$tag}; 8109 delete $$self{COMP_KEYS}{$tag}; 8110 } 5754 8111 } else { 5755 8112 $tag = $nextTag; # don't override the existing tag 5756 8113 } 5757 $self->{PRIORITY}{$tag} = $priority; 8114 $$self{PRIORITY}{$tag} = $priority; 8115 $$self{TAG_EXTRA}{$tag}{NoListDel} = 1 if $noListDel; 5758 8116 } elsif ($priority) { 5759 # set tag priority (only if exists and non-zero)5760 $ self->{PRIORITY}{$tag} = $priority;8117 # set tag priority (only if exists and is non-zero) 8118 $$self{PRIORITY}{$tag} = $priority; 5761 8119 } 5762 8120 5763 8121 # save the raw value, file order, tagInfo ref, group1 name, 5764 8122 # and tag key for lists if necessary 5765 $$rawValueHash{$tag} = $value; 5766 $self->{FILE_ORDER}{$tag} = ++$self->{NUM_FOUND}; 5767 $self->{TAG_INFO}{$tag} = $tagInfo; 5768 # set dynamic groups 1 and 3 if necessary 5769 $self->{TAG_EXTRA}{$tag}{G1} = $self->{SET_GROUP1} if $self->{SET_GROUP1}; 5770 if ($self->{DOC_NUM}) { 5771 $self->{TAG_EXTRA}{$tag}{G3} = $self->{DOC_NUM}; 5772 if ($self->{DOC_NUM} =~ /^(\d+)/) { 8123 $$valueHash{$tag} = $value; 8124 $$self{FILE_ORDER}{$tag} = ++$$self{NUM_FOUND}; 8125 $$self{TAG_INFO}{$tag} = $tagInfo; 8126 # set dynamic groups 0, 1 and 3 if necessary 8127 $$self{TAG_EXTRA}{$tag}{G0} = $grps[0] if $grps[0]; 8128 $$self{TAG_EXTRA}{$tag}{G1} = $grps[1] if $grps[1]; 8129 if ($$self{DOC_NUM}) { 8130 $$self{TAG_EXTRA}{$tag}{G3} = $$self{DOC_NUM}; 8131 if ($$self{DOC_NUM} =~ /^(\d+)/) { 5773 8132 # keep track of maximum 1st-level sub-document number 5774 $ self->{DOC_COUNT} = $1 unless $self->{DOC_COUNT} >= $1;8133 $$self{DOC_COUNT} = $1 unless $$self{DOC_COUNT} >= $1; 5775 8134 } 5776 8135 } 5777 8136 # save path if requested 5778 $ self->{TAG_EXTRA}{$tag}{G5} = $self->MetadataPath() if $self->{OPTIONS}{SavePath};8137 $$self{TAG_EXTRA}{$tag}{G5} = $self->MetadataPath() if $$options{SavePath}; 5779 8138 5780 8139 # remember this tagInfo if we will be accumulating values in a list 5781 $self->{LIST_TAGS}{$tagInfo} = $tag if $$tagInfo{List} and not $$self{NO_LIST}; 8140 # (but don't override earlier list if this may be deleted by NoListDel flag) 8141 if ($$tagInfo{List} and not $$self{NO_LIST} and not $noListDel) { 8142 $$self{LIST_TAGS}{$tagInfo} = $tag; 8143 } 8144 8145 # validate tag if requested (but only for simple values -- could result 8146 # in infinite recursion if called for a Composite tag (HASH ref value) 8147 # because FoundTag is called in the middle of building Composite tags 8148 if ($$options{Validate} and not ref $value) { 8149 Image::ExifTool::Validate::ValidateRaw($self, $tag, $value); 8150 } 5782 8151 5783 8152 return $tag; … … 5790 8159 { 5791 8160 my $self = shift; 5792 $ self->{PRIORITY_DIR} = $self->{DIR_NAME} unless $self->{PRIORITY_DIR};8161 $$self{PRIORITY_DIR} = $$self{DIR_NAME} unless $$self{PRIORITY_DIR}; 5793 8162 } 5794 8163 … … 5799 8168 { 5800 8169 my ($self, $tagKey, $extra, $fam) = @_; 5801 $ self->{TAG_EXTRA}{$tagKey}{defined $fam ? "G$fam" : 'G1'} = $extra;8170 $$self{TAG_EXTRA}{$tagKey}{defined $fam ? "G$fam" : 'G1'} = $extra; 5802 8171 } 5803 8172 … … 5808 8177 { 5809 8178 my ($self, $tag) = @_; 5810 delete $self->{VALUE}{$tag}; 5811 delete $self->{FILE_ORDER}{$tag}; 5812 delete $self->{TAG_INFO}{$tag}; 5813 delete $self->{TAG_EXTRA}{$tag}; 8179 delete $$self{VALUE}{$tag}; 8180 delete $$self{FILE_ORDER}{$tag}; 8181 delete $$self{TAG_INFO}{$tag}; 8182 delete $$self{TAG_EXTRA}{$tag}; 8183 delete $$self{PRIORITY}{$tag}; 8184 delete $$self{RATIONAL}{$tag}; 8185 delete $$self{BOTH}{$tag}; 5814 8186 } 5815 8187 … … 5838 8210 # 1) Optional file type (uses FILE_TYPE if not specified) 5839 8211 # 2) Optional MIME type (uses our lookup if not specified) 8212 # 3) Optional recommended extension (converted to lower case; uses FileType if undef) 5840 8213 # Notes: Will NOT set file type twice (subsequent calls ignored) 5841 sub SetFileType($;$$) 5842 { 5843 my ($self, $fileType, $mimeType) = @_; 5844 unless ($self->{VALUE}{FileType}) { 5845 my $baseType = $self->{FILE_TYPE}; 8214 sub SetFileType($;$$$) 8215 { 8216 my ($self, $fileType, $mimeType, $normExt) = @_; 8217 unless ($$self{VALUE}{FileType} and not $$self{DOC_NUM}) { 8218 my $baseType = $$self{FILE_TYPE}; 8219 my $ext = $$self{FILE_EXT}; 5846 8220 $fileType or $fileType = $baseType; 8221 # handle sub-types which are identified by extension 8222 if (defined $ext and $ext ne $fileType and not $$self{DOC_NUM}) { 8223 my ($f,$e) = @fileTypeLookup{$fileType,$ext}; 8224 if (ref $f eq 'ARRAY' and ref $e eq 'ARRAY' and $$f[0] eq $$e[0]) { 8225 # make sure $fileType was a root type and not another sub-type 8226 $fileType = $ext if $$f[0] eq $fileType or not $fileTypeLookup{$$f[0]}; 8227 } 8228 } 5847 8229 $mimeType or $mimeType = $mimeType{$fileType}; 5848 8230 # use base file type if necessary (except if 'TIFF', which is a special case) 5849 8231 $mimeType = $mimeType{$baseType} unless $mimeType or $baseType eq 'TIFF'; 8232 unless (defined $normExt) { 8233 $normExt = $fileTypeExt{$fileType}; 8234 $normExt = $fileType unless defined $normExt; 8235 } 8236 $$self{FileType} = $fileType; 5850 8237 $self->FoundTag('FileType', $fileType); 8238 $self->FoundTag('FileTypeExtension', uc $normExt); 5851 8239 $self->FoundTag('MIMEType', $mimeType || 'application/unknown'); 5852 8240 } … … 5855 8243 #------------------------------------------------------------------------------ 5856 8244 # Override the FileType and MIMEType tags 5857 # Inputs: 0) ExifTool object ref, 1) file type 8245 # Inputs: 0) ExifTool object ref, 1) file type, 2) MIME type, 3) normal extension 5858 8246 # Notes: does nothing if FileType was not previously defined (ie. when writing) 5859 sub OverrideFileType($$ )5860 { 5861 my ($self, $fileType ) = @_;8247 sub OverrideFileType($$;$$) 8248 { 8249 my ($self, $fileType, $mimeType, $normExt) = @_; 5862 8250 if (defined $$self{VALUE}{FileType} and $fileType ne $$self{VALUE}{FileType}) { 8251 $$self{FileType} = $fileType; 5863 8252 $$self{VALUE}{FileType} = $fileType; 5864 $$self{VALUE}{MIMEType} = $mimeType{$fileType} || 'application/unknown'; 8253 unless (defined $normExt) { 8254 $normExt = $fileTypeExt{$fileType}; 8255 $normExt = $fileType unless defined $normExt; 8256 } 8257 $$self{VALUE}{FileTypeExtension} = uc $normExt; 8258 $mimeType or $mimeType = $mimeType{$fileType}; 8259 $$self{VALUE}{MIMEType} = $mimeType if $mimeType; 5865 8260 if ($$self{OPTIONS}{Verbose}) { 5866 8261 $self->VPrint(0,"$$self{INDENT}FileType [override] = $fileType\n"); 5867 $self->VPrint(0,"$$self{INDENT}MIMEType [override] = $$self{VALUE}{MIMEType}\n"); 8262 $self->VPrint(0,"$$self{INDENT}FileTypeExtension [override] = $$self{VALUE}{FileTypeExtension}\n"); 8263 $self->VPrint(0,"$$self{INDENT}MIMEType [override] = $mimeType\n") if $mimeType; 5868 8264 } 5869 8265 } … … 5878 8274 my ($self, $mime) = @_; 5879 8275 $mime =~ m{/} or $mime = $mimeType{$mime} or return; 5880 my $old = $ self->{VALUE}{MIMEType};8276 my $old = $$self{VALUE}{MIMEType}; 5881 8277 if (defined $old) { 5882 8278 my ($a, $b) = split '/', $old; 5883 8279 my ($c, $d) = split '/', $mime; 5884 8280 $d =~ s/^x-//; 5885 $ self->{VALUE}{MIMEType} = "$c/$b-$d";8281 $$self{VALUE}{MIMEType} = "$c/$b-$d"; 5886 8282 $self->VPrint(0, " Modified MIMEType = $c/$b-$d\n"); 5887 8283 } else { … … 5897 8293 my $self = shift; 5898 8294 my $level = shift; 5899 if ($ self->{OPTIONS}{Verbose} and $self->{OPTIONS}{Verbose} > $level) {5900 my $out = $ self->{OPTIONS}{TextOut};8295 if ($$self{OPTIONS}{Verbose} and $$self{OPTIONS}{Verbose} > $level) { 8296 my $out = $$self{OPTIONS}{TextOut}; 5901 8297 print $out @_; 5902 } 8298 print $out "\n" unless $_[-1] =~ /\n$/; 8299 } 8300 } 8301 8302 #------------------------------------------------------------------------------ 8303 # Print verbose directory information 8304 # Inputs: 0) ExifTool object reference, 1) directory name or dirInfo ref 8305 # 2) number of entries in directory (or 0 if unknown) 8306 # 3) optional size of directory in bytes 8307 sub VerboseDir($$;$$) 8308 { 8309 my ($self, $name, $entries, $size) = @_; 8310 return unless $$self{OPTIONS}{Verbose}; 8311 if (ref $name eq 'HASH') { 8312 $size = $$name{DirLen} unless $size; 8313 $name = $$name{Name} || $$name{DirName}; 8314 } 8315 my $indent = substr($$self{INDENT}, 0, -2); 8316 my $out = $$self{OPTIONS}{TextOut}; 8317 my $str = ($entries or defined $entries and not $size) ? " with $entries entries" : ''; 8318 $str .= ", $size bytes" if $size; 8319 print $out "$indent+ [$name directory$str]\n"; 5903 8320 } 5904 8321 … … 5910 8327 my $self = shift; 5911 8328 my $dataPt = shift; 5912 if ($self->{OPTIONS}{Verbose} and $self->{OPTIONS}{Verbose} > 2) { 8329 my $verbose = $$self{OPTIONS}{Verbose}; 8330 if ($verbose and $verbose > 2) { 5913 8331 my %parms = ( 5914 Prefix => $ self->{INDENT},5915 Out => $ self->{OPTIONS}{TextOut},5916 MaxLen => $ self->{OPTIONS}{Verbose} < 4 ? 96: undef,8332 Prefix => $$self{INDENT}, 8333 Out => $$self{OPTIONS}{TextOut}, 8334 MaxLen => $verbose < 4 ? 96 : $verbose < 5 ? 2048 : undef, 5917 8335 ); 5918 8336 HexDump($dataPt, undef, %parms, @_); 5919 8337 } 8338 } 8339 8340 #------------------------------------------------------------------------------ 8341 # Print data in hex 8342 # Inputs: 0) data 8343 # Returns: hex string 8344 # (this is a convenience function for use in debugging PrintConv statements) 8345 sub PrintHex($) 8346 { 8347 my $val = shift; 8348 return join(' ', unpack('H2' x length($val), $val)); 5920 8349 } 5921 8350 … … 5931 8360 my ($isPreview, $buff); 5932 8361 5933 if ($tag and $tag eq 'PreviewImage') { 5934 # save PreviewImage start/length in case we want to dump trailer 5935 $$self{PreviewImageStart} = $offset; 5936 $$self{PreviewImageLength} = $length; 5937 $isPreview = 1; 5938 } 5939 if ($tag and not $self->{OPTIONS}{Binary} and not $self->{OPTIONS}{Verbose} and 5940 not $self->{REQ_TAG_LOOKUP}{lc($tag)}) 5941 { 5942 return "Binary data $length bytes"; 5943 } 5944 unless ($self->{RAF}->Seek($offset,0) 5945 and $self->{RAF}->Read($buff, $length) == $length) 8362 if ($tag) { 8363 if ($tag eq 'PreviewImage') { 8364 # save PreviewImage start/length in case we want to dump trailer 8365 $$self{PreviewImageStart} = $offset; 8366 $$self{PreviewImageLength} = $length; 8367 $isPreview = 1; 8368 } 8369 my $lcTag = lc $tag; 8370 if ((not $$self{OPTIONS}{Binary} or $$self{EXCL_TAG_LOOKUP}{$lcTag}) and 8371 not $$self{OPTIONS}{Verbose} and not $$self{REQ_TAG_LOOKUP}{$lcTag}) 8372 { 8373 return "Binary data $length bytes"; 8374 } 8375 } 8376 unless ($$self{RAF}->Seek($offset,0) 8377 and $$self{RAF}->Read($buff, $length) == $length) 5946 8378 { 5947 8379 $tag or $tag = 'binary data'; … … 5969 8401 my $size = $$dirInfo{DirLen} || (length($$dataPt) - $offset); 5970 8402 my $base = $$dirInfo{Base} || 0; 5971 my $verbose = $ self->{OPTIONS}{Verbose};5972 my $unknown = $ self->{OPTIONS}{Unknown};8403 my $verbose = $$self{OPTIONS}{Verbose}; 8404 my $unknown = $$self{OPTIONS}{Unknown}; 5973 8405 my $dataPos = $$dirInfo{DataPos} || 0; 5974 8406 … … 5982 8414 } 5983 8415 # prepare list of tag numbers to extract 5984 my @tags;8416 my (@tags, $topIndex); 5985 8417 if ($unknown > 1 and defined $$tagTablePtr{FIRST_ENTRY}) { 8418 # don't create a stupid number of tags if data is huge 8419 my $sizeLimit = $size < 65536 ? $size : 65536; 5986 8420 # scan through entire binary table 5987 @tags = ($$tagTablePtr{FIRST_ENTRY}..(int($size/$increment) - 1)); 8421 $topIndex = int($sizeLimit/$increment); 8422 @tags = ($$tagTablePtr{FIRST_ENTRY}..($topIndex - 1)); 5988 8423 # add in floating point tag ID's if they exist 5989 8424 my @ftags = grep /\./, TagTableKeys($tagTablePtr); … … 5992 8427 @tags = @{$$dirInfo{DataMember}}; 5993 8428 $verbose = 0; # no verbose output of extracted values when writing 8429 } elsif ($$dirInfo{MixedTags}) { 8430 # process sorted integer-ID tags only 8431 @tags = sort { $a <=> $b } grep /^\d+$/, TagTableKeys($tagTablePtr); 5994 8432 } else { 5995 8433 # extract known tags in numerical order 5996 @tags = sort { $a <=> $b} TagTableKeys($tagTablePtr);8434 @tags = sort { ($a < 0 ? $a + 1e9 : $a) <=> ($b < 0 ? $b + 1e9 : $b) } TagTableKeys($tagTablePtr); 5997 8435 } 5998 8436 $self->VerboseDir('BinaryData', undef, $size) if $verbose; … … 6003 8441 my $varSize = 0; 6004 8442 foreach $index (@tags) { 6005 my ($tagInfo, $val, $saveNextIndex, $len, $mask, $wasVar );8443 my ($tagInfo, $val, $saveNextIndex, $len, $mask, $wasVar, $rational); 6006 8444 if ($$tagTablePtr{$index}) { 6007 8445 $tagInfo = $self->GetTagInfo($tagTablePtr, $index); … … 6009 8447 next unless defined $tagInfo; 6010 8448 my $entry = int($index) * $increment + $varSize; 8449 if ($entry < 0) { 8450 $entry += $size; 8451 next if $entry < 0; 8452 } 6011 8453 next if $entry >= $size; 6012 8454 my $more = $size - $entry; … … 6018 8460 next if $$tagInfo{Unknown} and 6019 8461 ($$tagInfo{Unknown} > $unknown or $index < $nextIndex); 8462 } elsif ($topIndex and $$tagTablePtr{$index - $topIndex}) { 8463 $tagInfo = $self->GetTagInfo($tagTablePtr, $index - $topIndex) or next; 6020 8464 } else { 6021 8465 # don't generate unknown tags in binary tables unless Unknown > 1 … … 6027 8471 # get relative offset of this entry 6028 8472 my $entry = int($index) * $increment + $varSize; 8473 # allow negative indices to represent bytes from end 8474 if ($entry < 0) { 8475 $entry += $size; 8476 next if $entry < 0; 8477 } 6029 8478 my $more = $size - $entry; 6030 8479 last if $more <= 0; # all done if we have reached the end of data … … 6050 8499 $@ and warn("Format $$tagInfo{Name}: $@"), next; 6051 8500 next if $count < 0; 6052 # allow a variable-length of any format type (with base $count = 1) 8501 # allow a variable-length value of any format 8502 # (note: the next incremental index points to data immediately after 8503 # this value, regardless of the size of this value, even if it is zero) 6053 8504 if ($format =~ s/^var_//) { 6054 $varSize += ($count - 1) * ($formatSize{$format} || 1); 8505 $varSize += $count * ($formatSize{$format} || 1) - $increment; 8506 $wasVar = 1; 6055 8507 # save variable size data if required for writing 6056 8508 if ($$dirInfo{VarFormatData}) { 6057 push @{$$dirInfo{VarFormatData}}, $index, $varSize;8509 push @{$$dirInfo{VarFormatData}}, [ $index, $varSize, $format ]; 6058 8510 } 8511 # don't extract value if large and we wanted it just to get 8512 # the variable-format information when writing 8513 next if $$tagInfo{LargeTag} and $$dirInfo{VarFormatData}; 6059 8514 } 6060 8515 } elsif ($format =~ /^var_/) { … … 6069 8524 $count = Get8u($dataPt, ($entry++)+$offset); 6070 8525 --$more; 6071 } elsif ($format eq 'pstr32' ) {8526 } elsif ($format eq 'pstr32' or $format eq 'ustr32') { 6072 8527 last if $more < 4; 6073 8528 $count = Get32u($dataPt, $entry + $offset); 8529 $count *= 2 if $format eq 'ustr32'; 6074 8530 $entry += 4; 6075 8531 $more -= 4; 8532 $nextIndex += 4 / $increment; # (increment next index for int32u) 6076 8533 } elsif ($format eq 'int16u') { 6077 8534 # int16u size of binary data to follow … … 6080 8537 $varSize -= 2; # ($count includes size word) 6081 8538 $format = 'undef'; 8539 } elsif ($format eq 'ue7') { 8540 require Image::ExifTool::BPG; 8541 ($val, $count) = Image::ExifTool::BPG::Get_ue7($dataPt, $entry + $offset); 8542 last unless defined $val; 8543 --$varSize; # ($count includes base size of 1 byte) 6082 8544 } elsif ($$dataPt =~ /\0/g) { 6083 8545 $count = pos($$dataPt) - ($entry+$offset); … … 6086 8548 $count = $more if not defined $count or $count > $more; 6087 8549 $varSize += $count; # shift subsequent indices 6088 $val = substr($$dataPt, $entry+$offset, $count); 6089 $val = $self->Decode($val, 'UCS2') if $format eq 'ustring'; 6090 $val =~ s/\0.*//s unless $format eq 'undef'; # truncate at null 8550 unless (defined $val) { 8551 $val = substr($$dataPt, $entry+$offset, $count); 8552 $val = $self->Decode($val, 'UCS2') if $format eq 'ustring' or $format eq 'ustr32'; 8553 $val =~ s/\0.*//s unless $format eq 'undef'; # truncate at null 8554 } 6091 8555 $wasVar = 1; 6092 8556 # save variable size data if required for writing 6093 8557 if ($$dirInfo{VarFormatData}) { 6094 push @{$$dirInfo{VarFormatData}}, $index, $varSize;8558 push @{$$dirInfo{VarFormatData}}, [ $index, $varSize, $format ]; 6095 8559 } 6096 8560 } … … 6098 8562 # hook to allow format, etc to be set dynamically 6099 8563 if (defined $$tagInfo{Hook}) { 6100 #### eval Hook ($format, $varSize) 8564 my $oldVarSize = $varSize; 8565 my $pos = $entry + $offset; 8566 #### eval Hook ($format, $varSize, $size, $dataPt, $pos) 6101 8567 eval $$tagInfo{Hook}; 6102 8568 # save variable size data if required for writing (in case changed by Hook) 6103 8569 if ($$dirInfo{VarFormatData}) { 6104 $#{$$dirInfo{VarFormatData}} -= 2 if $wasVar; # remove previous entries for this tag 6105 push @{$$dirInfo{VarFormatData}}, $index, $varSize; 8570 $#{$$dirInfo{VarFormatData}} -= 1 if $wasVar; # remove previous entry for this tag 8571 push @{$$dirInfo{VarFormatData}}, [ $index, $varSize, $format ]; 8572 } elsif ($varSize != $oldVarSize and $verbose > 2) { 8573 my ($tmp, $sign) = ($varSize, '+'); 8574 $tmp < 0 and $tmp = -$tmp, $sign = '-'; 8575 $self->VPrint(2, sprintf("$$self{INDENT}\[offsets adjusted by ${sign}0x%.4x after 0x%.4x $$tagInfo{Name}]\n", $tmp, $index)); 6106 8576 } 6107 8577 } … … 6113 8583 $nextIndex = $ni unless $nextIndex > $ni; 6114 8584 } 8585 # allow large tags to be excluded from extraction 8586 # (provides a work-around for some tight memory situations) 8587 next if $$tagInfo{LargeTag} and $$self{EXCL_TAG_LOOKUP}{lc $$tagInfo{Name}}; 6115 8588 # read value now if necessary 6116 8589 unless (defined $val and not $$tagInfo{SubDirectory}) { 6117 $val = ReadValue($dataPt, $entry+$offset, $format, $count, $more );8590 $val = ReadValue($dataPt, $entry+$offset, $format, $count, $more, \$rational); 6118 8591 $mask = $$tagInfo{Mask}; 6119 $val &= $maskif $mask;8592 $val = ($val & $mask) >> $$tagInfo{BitShift} if $mask; 6120 8593 } 6121 8594 if ($verbose and not $$tagInfo{Hidden}) { … … 6140 8613 # parse nested BinaryData directories 6141 8614 if ($$tagInfo{SubDirectory}) { 6142 my $subTablePtr = GetTagTable($tagInfo->{SubDirectory}{TagTable}); 8615 my $subdir = $$tagInfo{SubDirectory}; 8616 my $subTablePtr = GetTagTable($$subdir{TagTable}); 6143 8617 # use specified subdirectory length if given 6144 8618 if ($$tagInfo{Format} and $formatSize{$format}) { … … 6146 8620 $len = $more if $len > $more; 6147 8621 } else { 6148 $len = $more; 8622 $len = $more; # directory size is all of remaining data 6149 8623 if ($$subTablePtr{PROCESS_PROC} and 6150 8624 $$subTablePtr{PROCESS_PROC} eq \&ProcessBinaryData) … … 6154 8628 } 6155 8629 } 8630 my $subdirBase = $base; 8631 if (defined $$subdir{Base}) { 8632 #### eval Base ($start,$base) 8633 my $start = $entry + $offset + $dataPos; 8634 $subdirBase = eval($$subdir{Base}) + $base; 8635 } 8636 my $start = $$subdir{Start} || 0; 6156 8637 my %subdirInfo = ( 6157 8638 DataPt => $dataPt, 6158 8639 DataPos => $dataPos, 6159 DirStart => $entry + $offset, 6160 DirLen => $len, 6161 Base => $base, 8640 DataLen => length $$dataPt, 8641 DirStart => $entry + $offset + $start, 8642 DirLen => $len - $start, 8643 Base => $subdirBase, 6162 8644 ); 6163 $self->ProcessDirectory(\%subdirInfo, $subTablePtr); 8645 delete $$self{NO_UNKNOWN}; 8646 $self->ProcessDirectory(\%subdirInfo, $subTablePtr, $$subdir{ProcessProc}); 8647 $$self{NO_UNKNOWN} = 1 if $unknown < 2; 6164 8648 next; 6165 8649 } 6166 8650 if ($$tagInfo{IsOffset} and $$tagInfo{IsOffset} ne '3') { 6167 my $e xifTool= $self;6168 #### eval IsOffset ($val, $e xifTool)8651 my $et = $self; 8652 #### eval IsOffset ($val, $et) 6169 8653 $val += $base + $$self{BASE} if eval $$tagInfo{IsOffset}; 6170 8654 } 6171 8655 $val{$index} = $val; 6172 unless ($self->FoundTag($tagInfo,$val)) { 8656 my $oldBase; 8657 if ($$tagInfo{SetBase}) { 8658 $oldBase = $$self{BASE}; 8659 $$self{BASE} += $base; 8660 } 8661 my $key = $self->FoundTag($tagInfo,$val); 8662 $$self{BASE} = $oldBase if defined $oldBase; 8663 if ($key) { 8664 $$self{RATIONAL}{$key} = $rational if defined $rational; 8665 } else { 6173 8666 # don't increment nextIndex if we didn't extract a tag 6174 8667 $nextIndex = $saveNextIndex if defined $saveNextIndex; … … 6183 8676 # (use of noConfig is now deprecated, use configFile = '' instead) 6184 8677 until ($Image::ExifTool::noConfig) { 6185 my $file = $Image::ExifTool::configFile; 6186 if (not defined $file) { 6187 my $config = '.ExifTool_config'; 8678 my $config = $Image::ExifTool::configFile; 8679 my $file; 8680 if (not defined $config) { 8681 $config = '.ExifTool_config'; 6188 8682 # get our home directory (HOMEDRIVE and HOMEPATH are used in Windows cmd shell) 6189 8683 my $home = $ENV{EXIFTOOL_HOME} || $ENV{HOME} || … … 6191 8685 # look for the config file in 1) the home directory, 2) the program dir 6192 8686 $file = "$home/$config"; 6193 -r $file or $file = ($0 =~ /(.*[\\\/])/ ? $1 : './') . $config;6194 -r $file or last;6195 8687 } else { 6196 length $file or last; # filename of "" disables configuration 6197 -r $file or warn("Config file not found\n"), last; 6198 } 6199 eval "require '$file'"; # load the config file 8688 length $config or last; # filename of "" disables configuration 8689 $file = $config; 8690 } 8691 # also check executable directory unless path is absolute 8692 $exePath = $0 unless defined $exePath; # (undocumented $exePath setting) 8693 -r $file or $config =~ /^\// or $file = ($exePath =~ /(.*[\\\/])/ ? $1 : './') . $config; 8694 unless (-r $file) { 8695 warn("Config file not found\n") if defined $Image::ExifTool::configFile; 8696 last; 8697 } 8698 unshift @INC, '.'; # look in current directory first 8699 eval { require $file }; # load the config file 8700 shift @INC; 6200 8701 # print warning (minus "Compilation failed" part) 6201 8702 $@ and $_=$@, s/Compilation failed.*//s, warn $_; 6202 if (@Image::ExifTool::UserDefined::Lenses) {6203 foreach (@Image::ExifTool::UserDefined::Lenses) {6204 $Image::ExifTool::userLens{$_} = 1;6205 }6206 }6207 8703 last; 6208 8704 } 8705 # read user-defined lenses (may have been defined by script instead of config file) 8706 if (@Image::ExifTool::UserDefined::Lenses) { 8707 foreach (@Image::ExifTool::UserDefined::Lenses) { 8708 $Image::ExifTool::userLens{$_} = 1; 8709 } 8710 } 8711 # add user-defined file types 8712 if (%Image::ExifTool::UserDefined::FileTypes) { 8713 foreach (sort keys %Image::ExifTool::UserDefined::FileTypes) { 8714 my $fileInfo = $Image::ExifTool::UserDefined::FileTypes{$_}; 8715 my $type = uc $_; 8716 ref $fileInfo eq 'HASH' or $fileTypeLookup{$type} = $fileInfo, next; 8717 my $baseType = $$fileInfo{BaseType}; 8718 if ($baseType) { 8719 if ($$fileInfo{Description}) { 8720 $fileTypeLookup{$type} = [ $baseType, $$fileInfo{Description} ]; 8721 } else { 8722 $fileTypeLookup{$type} = $baseType; 8723 } 8724 if (defined $$fileInfo{Writable} and not $$fileInfo{Writable}) { 8725 # first make sure we are using an actual base type and not a derived type 8726 $baseType = $fileTypeLookup{$baseType} while $baseType and not ref $fileTypeLookup{$baseType}; 8727 # mark this type as not writable 8728 $noWriteFile{$baseType} or $noWriteFile{$baseType} = [ ]; 8729 push @{$noWriteFile{$baseType}}, $type; 8730 } 8731 } else { 8732 $fileTypeLookup{$type} = [ $type, $$fileInfo{Description} || $type ]; 8733 $moduleName{$type} = 0; # not supported 8734 if ($$fileInfo{Magic}) { 8735 $magicNumber{$type} = $$fileInfo{Magic}; 8736 push @fileTypes, $type unless grep /^$type$/, @fileTypes; 8737 } 8738 } 8739 $mimeType{$type} = $$fileInfo{MIMEType} if defined $$fileInfo{MIMEType}; 8740 } 8741 } 6209 8742 6210 8743 #------------------------------------------------------------------------------
Note:
See TracChangeset
for help on using the changeset viewer.