require 5.004;
use vars qw($VERSION $RELEASE @ISA %EXPORT_TAGS $AUTOLOAD @fileTypes %allTables @tableOrder $exifAPP1hdr $xmpAPP1hdr $xmpExtAPP1hdr $psAPP13hdr
$psAPP13old @loadAllTables %UserDefined $evalWarning %noWriteFile
%magicNumber);
$VERSION = '7.50';
$RELEASE = '';
@ISA = qw(Exporter);
%EXPORT_TAGS = (
Public => [qw(
ImageInfo GetTagName GetShortcuts GetAllTags GetWritableTags
GetAllGroups GetDeleteGroups GetFileType CanWrite CanCreate
)],
DataAccess => [qw(
ReadValue GetByteOrder SetByteOrder ToggleByteOrder Get8u Get8s Get16u
Get16s Get32u Get32s Get64u GetFloat GetDouble GetFixed32s Write
WriteValue Tell Set8u Set8s Set16u Set32u
)],
Utils => [qw(
GetTagTable TagTableKeys GetTagInfoList GenerateTagIDs
)],
Vars => [qw(
%allTables @tableOrder @fileTypes
)],
);
Exporter::export_ok_tags(keys %EXPORT_TAGS);
{ my $t = "\xff"; die "Incompatible encoding!\n" if ord($t) != 0xff; }
sub SetNewValue($;$$%);
sub SetNewValuesFromFile($$;@);
sub GetNewValues($;$$);
sub CountNewValues($);
sub SaveNewValues($);
sub RestoreNewValues($);
sub WriteInfo($$;$$);
sub SetFileModifyDate($$;$);
sub SetFileName($$;$);
sub GetAllTags(;$);
sub GetWritableTags(;$);
sub GetAllGroups($);
sub GetNewGroups($);
sub GetDeleteGroups();
sub InsertTagValues($$$;$);
sub IsWritable($);
sub GetNewFileName($$);
sub LoadAllTables();
sub GetNewTagInfoList($;$);
sub GetNewTagInfoHash($@);
sub GetLangInfo($$);
sub Get64s($$);
sub Get64u($$);
sub GetExtended($$);
sub DecodeBits($$;$);
sub EncodeBits($$;$$);
sub HexDump($;$%);
sub DumpTrailer($$);
sub DumpUnknownTrailer($$);
sub VerboseInfo($$$%);
sub VerboseDir($$;$$);
sub VerboseValue($$$);
sub VPrint($$@);
sub Rationalize($;$);
sub Write($@);
sub ProcessTrailers($$);
sub WriteTrailerBuffer($$$);
sub AddNewTrailers($;@);
sub Tell($);
sub WriteValue($$;$$$$);
sub WriteDirectory($$$;$);
sub WriteBinaryData($$$);
sub CheckBinaryData($$$);
sub WriteTIFF($$$);
sub Charset2Unicode($$;$);
sub Latin2Unicode($$);
sub UTF82Unicode($$;$);
sub Unicode2Charset($$;$);
sub Unicode2Latin($$;$);
sub Unicode2UTF8($$);
sub PackUTF8(@);
sub UnpackUTF8($);
sub SetPreferredByteOrder($);
@loadAllTables = qw(
PhotoMechanic Exif GeoTiff CanonRaw KyoceraRaw MinoltaRaw SigmaRaw JPEG
Jpeg2000 BMP BMP PICT PNG MNG MIFF PDF PostScript Photoshop::Header
FujiFilm::RAF Panasonic::Raw Sony::SR2SubIFD ITC ID3 Vorbis FLAC APE
APE::NewHeader APE::OldHeader MPC MPEG::Audio MPEG::Video MPEG::VBR
QuickTime QuickTime::ImageFile Flash Flash::FLV Real::Media Real::Audio
Real::Metafile RIFF AIFF ASF DICOM DjVu MIE HTML XMP::SVG EXE EXE::PEVersion
EXE::PEString EXE::MachO EXE::PEF EXE::ELF Rawzor ZIP
);
@fileTypes = qw(JPEG CRW TIFF GIF MRW RAF X3F JP2 PNG MIE MIFF PS PDF PSD XMP
BMP PPM RIFF AIFF ASF MOV MPEG Real SWF FLV OGG FLAC APE MPC
ICC ITC HTML VRD QTIF FPX PICT ZIP RWZ EXE RAW MP3 DICM);
my @writeTypes = qw(JPEG TIFF GIF CRW MRW ORF RAF PNG MIE PSD XMP PPM EPS PS
PDF ICC VRD JP2);
%noWriteFile = (
TIFF => [ qw(3FR DCR K25 KDC ARW SRF SR2) ],
XMP => [ 'SVG' ],
);
my @createTypes = qw(XMP ICC MIE VRD);
my %fileTypeLookup = (
'3FR' => ['TIFF', 'Hasselblad RAW format (TIFF-like)'],
ACR => ['DICM', 'American College of Radiology ACR-NEMA'],
AI => [['PDF','PS'], 'Adobe Illustrator (PDF-like or PS-like)'],
AIF => ['AIFF', 'Audio Interchange File Format'],
AIFC => ['AIFF', 'Audio Interchange File Format Compressed'],
AIFF => ['AIFF', 'Audio Interchange File Format'],
APE => ['APE', "Monkey's Audio format"],
ARW => ['TIFF', 'Sony Alpha RAW format (TIFF-like)'],
ASF => ['ASF', 'Microsoft Advanced Systems Format'],
AVI => ['RIFF', 'Audio Video Interleaved (RIFF-based)'],
BMP => ['BMP', 'Windows BitMaP'],
BTF => ['BTF', 'Big Tagged Image File Format'],
CIFF => ['CRW', 'Camera Image File Format (same as CRW)'],
CR2 => ['TIFF', 'Canon RAW 2 format (TIFF-like)'],
CRW => ['CRW', 'Canon RAW format'],
CS1 => ['PSD', 'Sinar CaptureShop 1-Shot RAW (PSD-like)'],
DC3 => ['DICM', 'DICOM image file'],
DCM => ['DICM', 'DICOM image file'],
DIB => ['BMP', 'Device Independent Bitmap (aka. BMP)'],
DIC => ['DICM', 'DICOM image file'],
DICM => ['DICM', 'DICOM image file'],
DIVX => ['ASF', 'DivX media format (ASF-based)'],
DJV => ['AIFF', 'DjVu image (IFF-based)'],
DJVU => ['AIFF', 'DjVu image (IFF-based)'],
DLL => ['EXE', 'Windows Dynamic Link Library'],
DNG => ['TIFF', 'Digital Negative (TIFF-like)'],
DCR => ['TIFF', 'Kodak Digital Camera RAW (TIFF-like)'],
DOC => ['FPX', 'Microsoft Word Document (FPX-like)'],
DYLIB=> ['EXE', 'Mach-O Dynamic Link Library'],
EPS => ['EPS', 'Encapsulated PostScript Format'],
EPSF => ['EPS', 'Encapsulated PostScript Format'],
ERF => ['TIFF', 'Epson Raw Format (TIFF-like)'],
EXE => ['EXE', 'Windows executable file'],
FLAC => ['FLAC', 'Free Lossless Audio Codec'],
FLV => ['FLV', 'Flash Video'],
FPX => ['FPX', 'FlashPix'],
GIF => ['GIF', 'Compuserve Graphics Interchange Format'],
HDP => ['TIFF', 'Windows HD Photo (TIFF-based)'],
HTM => ['HTML', 'HyperText Markup Language'],
HTML => ['HTML', 'HyperText Markup Language'],
ICC => ['ICC', 'International Color Consortium'],
ICM => ['ICC', 'International Color Consortium'],
ITC => ['ITC', 'iTunes Cover Flow'],
JNG => ['PNG', 'JPG Network Graphics (PNG-like)'],
JP2 => ['JP2', 'JPEG 2000 file'],
JPEG => ['JPEG', 'Joint Photographic Experts Group'],
JPG => ['JPEG', 'Joint Photographic Experts Group'],
JPX => ['JP2', 'JPEG 2000 file'],
K25 => ['TIFF', 'Kodak DC25 RAW (TIFF-like)'],
KDC => ['TIFF', 'Kodak Digital Camera RAW (TIFF-like)'],
M4A => ['MOV', 'MPG4 Audio (QuickTime-based)'],
MEF => ['TIFF', 'Mamiya (RAW) Electronic Format (TIFF-like)'],
MIE => ['MIE', 'Meta Information Encapsulation format'],
MIF => ['MIFF', 'Magick Image File Format'],
MIFF => ['MIFF', 'Magick Image File Format'],
MNG => ['PNG', 'Multiple-image Network Graphics (PNG-like)'],
MOS => ['TIFF', 'Creo Leaf Mosaic (TIFF-like)'],
MOV => ['MOV', 'Apple QuickTime movie'],
MP3 => ['MP3', 'MPEG Layer 3 audio (uses ID3 information)'],
MP4 => ['MOV', 'MPEG Layer 4 video (QuickTime-based)'],
MPC => ['MPC', 'Musepack Audio'],
MPEG => ['MPEG', 'MPEG audio/video format 1'],
MPG => ['MPEG', 'MPEG audio/video format 1'],
MRW => ['MRW', 'Minolta RAW format'],
NEF => ['TIFF', 'Nikon (RAW) Electronic Format (TIFF-like)'],
OGG => ['OGG', 'Ogg Vorbis audio file'],
ORF => ['ORF', 'Olympus RAW format'],
PBM => ['PPM', 'Portable BitMap (PPM-like)'],
PCT => ['PICT', 'Apple PICTure'],
PDF => ['PDF', 'Adobe Portable Document Format'],
PEF => ['TIFF', 'Pentax (RAW) Electronic Format (TIFF-like)'],
PGM => ['PPM', 'Portable Gray Map (PPM-like)'],
PICT => ['PICT', 'Apple PICTure'],
PNG => ['PNG', 'Portable Network Graphics'],
PPM => ['PPM', 'Portable Pixel Map'],
PPT => ['FPX', 'Microsoft PowerPoint presentation (FPX-like)'],
PS => ['PS', 'PostScript'],
PSD => ['PSD', 'PhotoShop Drawing'],
QIF => ['QTIF', 'QuickTime Image File'],
QT => ['MOV', 'QuickTime movie'],
QTI => ['QTIF', 'QuickTime Image File'],
QTIF => ['QTIF', 'QuickTime Image File'],
RA => ['Real', 'Real Audio'],
RAF => ['RAF', 'FujiFilm RAW Format'],
RAM => ['Real', 'Real Audio Metafile'],
RAW => ['RAW', 'Kyocera Contax N Digital RAW or Panasonic RAW'],
RIF => ['RIFF', 'Resource Interchange File Format'],
RIFF => ['RIFF', 'Resource Interchange File Format'],
RM => ['Real', 'Real Media'],
RMVB => ['Real', 'Real Media Variable Bitrate'],
RPM => ['Real', 'Real Media Plug-in Metafile'],
RV => ['Real', 'Real Video'],
RWZ => ['RWZ', 'Rawzor compressed image'],
SO => ['EXE', 'Shared Object file'],
SR2 => ['TIFF', 'Sony RAW Format 2 (TIFF-like)'],
SRF => ['TIFF', 'Sony RAW Format (TIFF-like)'],
SVG => ['XMP', 'Scalable Vector Graphics (XML-based)'],
SWF => ['SWF', 'Shockwave Flash'],
THM => ['JPEG', 'Canon Thumbnail (aka. JPG)'],
TIF => ['TIFF', 'Tagged Image File Format'],
TIFF => ['TIFF', 'Tagged Image File Format'],
VRD => ['VRD', 'Canon VRD Recipe Data (written by DPP)'],
WAV => ['RIFF', 'WAVeform (Windows digital audio format)'],
WDP => ['TIFF', 'Windows Media Photo (TIFF-based)'],
WMA => ['ASF', 'Windows Media Audio (ASF-based)'],
WMV => ['ASF', 'Windows Media Video (ASF-based)'],
X3F => ['X3F', 'Sigma RAW format'],
XHTML=> ['HTML', 'Extensible HyperText Markup Language'],
XLS => ['FPX', 'Microsoft Excel worksheet (FPX-like)'],
XMP => ['XMP', 'Extensible Metadata Platform data file'],
ZIP => ['ZIP', 'ZIP archive'],
);
my %mimeType = (
'3FR' => 'image/x-raw',
AIFF => 'audio/aiff',
APE => 'audio/x-monkeys-audio',
ASF => 'video/x-ms-asf',
ARW => 'image/x-raw',
AVI => 'video/avi',
BMP => 'image/bmp',
BTF => 'application/unknown',
'Canon 1D RAW' => 'image/x-raw',
CR2 => 'image/x-raw',
CRW => 'image/x-raw',
EPS => 'application/postscript',
ERF => 'image/x-raw',
EXE => 'application/octet-stream',
DCR => 'image/x-raw',
DICM => 'application/dicom',
DIVX => 'video/divx',
DJVU => 'image/vnd.djvu',
DNG => 'image/x-raw',
DOC => 'application/msword',
FLAC => 'audio/flac',
FLV => 'video/x-flv',
FPX => 'image/vnd.fpx',
GIF => 'image/gif',
HDP => 'image/vnd.ms-photo',
HTML => 'text/html',
ITC => 'application/itunes',
JNG => 'image/jng',
JP2 => 'image/jp2',
JPEG => 'image/jpeg',
K25 => 'image/x-raw',
KDC => 'image/x-raw',
M4A => 'audio/mp4',
MEF => 'image/x-raw',
MIE => 'application/x-mie',
MIFF => 'application/x-magick-image',
MNG => 'video/mng',
MOS => 'image/x-raw',
MOV => 'video/quicktime',
MP3 => 'audio/mpeg',
MP4 => 'video/mp4',
MPC => 'audio/x-musepack',
MPEG => 'video/mpeg',
MRW => 'image/x-raw',
NEF => 'image/x-raw',
OGG => 'audio/x-ogg',
ORF => 'image/x-raw',
PBM => 'image/x-portable-bitmap',
PDF => 'application/pdf',
PEF => 'image/x-raw',
PGM => 'image/x-portable-graymap',
PICT => 'image/pict',
PNG => 'image/png',
PPM => 'image/x-portable-pixmap',
PPT => 'application/vnd.ms-powerpoint',
PS => 'application/postscript',
PSD => 'application/photoshop',
QTIF => 'image/x-quicktime',
RA => 'audio/x-pn-realaudio',
RAF => 'image/x-raw',
RAM => 'audio/x-pn-realaudio',
RAW => 'image/x-raw',
RM => 'application/vnd.rn-realmedia',
RMVB => 'application/vnd.rn-realmedia-vbr',
RPM => 'audio/x-pn-realaudio-plugin',
RV => 'video/vnd.rn-realvideo',
RWZ => 'image/x-rawzor',
SR2 => 'image/x-raw',
SRF => 'image/x-raw',
SVG => 'image/svg+xml',
SWF => 'application/x-shockwave-flash',
TIFF => 'image/tiff',
WAV => 'audio/x-wav',
WDP => 'image/vnd.ms-photo',
WMA => 'audio/x-ms-wma',
WMV => 'video/x-ms-wmv',
X3F => 'image/x-raw',
XLS => 'application/vnd.ms-excel',
XML => 'application/xml',
XMP => 'application/rdf+xml',
ZIP => 'application/zip',
);
my %moduleName = (
BTF => 'BigTIFF',
CRW => 'CanonRaw',
DICM => 'DICOM',
EPS => 'PostScript',
ICC => 'ICC_Profile',
FLV => 'Flash',
FPX => 'FlashPix',
JP2 => 'Jpeg2000',
JPEG => '',
MOV => 'QuickTime',
MP3 => 'ID3',
MRW => 'MinoltaRaw',
OGG => 'Vorbis',
ORF => 'Olympus',
PS => 'PostScript',
PSD => 'Photoshop',
QTIF => 'QuickTime',
RAF => 'FujiFilm',
RAW => 'KyoceraRaw',
RWZ => 'Rawzor',
SWF => 'Flash',
TIFF => '',
VRD => 'CanonVRD',
X3F => 'SigmaRaw',
);
my %magicNumber = (
AIFF => '(FORM....AIF[FC]|AT&TFORM)',
APE => '(MAC |APETAGEX|ID3)',
ASF => '\x30\x26\xb2\x75\x8e\x66\xcf\x11\xa6\xd9\x00\xaa\x00\x62\xce\x6c',
BMP => 'BM',
CRW => '(II|MM).{4}HEAP(CCDR|JPGM)',
DICM => '(.{128}DICM|\0[\x02\x04\x06\x08]\0[\0-\x20]|[\x02\x04\x06\x08]\0[\0-\x20]\0)',
EXE => '(MZ|\xca\xfe\xba\xbe|\xfe\xed\xfa[\xce\xcf]|[\xce\xcf]\xfa\xed\xfe|Joy!peff|\x7fELF|#!\s*/\S*bin/|!<arch>\x0a)',
FLAC => '(fLaC|ID3)',
FLV => 'FLV\x01',
FPX => '\xd0\xcf\x11\xe0\xa1\xb1\x1a\xe1',
GIF => 'GIF8[79]a',
HTML => '(?i)<(!DOCTYPE\s+HTML|HTML|\?xml)',
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}',
ITC => '.{4}itch',
JP2 => '\0\0\0\x0cjP( |\x1a\x1a)\x0d\x0a\x87\x0a',
JPEG => '\xff\xd8\xff',
MIE => '~[\x10\x18]\x04.0MIE',
MIFF => 'id=ImageMagick',
MOV => '.{4}(free|skip|wide|ftyp|pnot|PICT|pict|moov|mdat|junk|uuid)',
MPC => '(MP\+|ID3)',
MPEG => '\0\0\x01[\xb0-\xbf]',
MRW => '\0MR[MI]',
OGG => '(OggS|ID3)',
PDF => '%PDF-\d+\.\d+',
PICT => '(.{10}|.{522})(\x11\x01|\x00\x11)',
PNG => '(\x89P|\x8aM|\x8bJ)NG\r\n\x1a\n',
PPM => 'P[1-6]\s+',
PS => '(%!PS|%!Ad|\xc5\xd0\xd3\xc6)',
PSD => '8BPS\0\x01',
QTIF => '.{4}(idsc|idat|iicc)',
RAF => 'FUJIFILM',
RAW => '.{25}ARECOYK',
RIFF => 'RIFF',
RWZ => 'rawzor',
SWF => '[FC]WS[^\0]',
TIFF => '(II|MM)',
VRD => 'CANON OPTIONAL DATA\0',
X3F => 'FOVb',
XMP => '\0{0,3}(\xfe\xff|\xff\xfe|\xef\xbb\xbf)?\0{0,3}<',
ZIP => 'PK\x03\x04',
);
my @defaultWriteGroups = qw(EXIF IPTC XMP MakerNotes Photoshop ICC_Profile CanonVRD);
my %allGroupsExifTool = ( 0 => 'ExifTool', 1 => 'ExifTool', 2 => 'ExifTool' );
my %specialTags = (
PROCESS_PROC=>1, WRITE_PROC=>1, CHECK_PROC=>1, GROUPS=>1, FORMAT=>1,
FIRST_ENTRY=>1, TAG_PREFIX=>1, PRINT_CONV=>1, DID_TAG_ID=>1, WRITABLE=>1,
NOTES=>1, IS_OFFSET=>1, EXTRACT_UNKNOWN=>1, NAMESPACE=>1, PREFERRED=>1,
PARENT=>1, PRIORITY=>1, WRITE_GROUP=>1, LANG_INFO=>1, VARS=>1,
DATAMEMBER=>1, SET_GROUP1=>1,
);
$exifAPP1hdr = "Exif\0\0";
$psAPP13hdr = "Photoshop 3.0\0";
$psAPP13old = 'Adobe_Photoshop2.5:';
sub DummyWriteProc { return 1; }
%Image::ExifTool::userLens = ( );
%Image::ExifTool::previewImageTagInfo = (
Name => 'PreviewImage',
Writable => 'undef',
WriteCheck => '$val eq "none" ? undef : $self->CheckImage(\$val)',
DataTag => 'PreviewImage',
RawConv => '$self->ValidateImage(\$val,$tag)',
ValueConvInv => '$val eq "" and $val="none"; $val',
);
%Image::ExifTool::Extra = (
GROUPS => { 0 => 'File', 1 => 'File', 2 => 'Image' },
DID_TAG_ID => 1,
WRITE_PROC => \&DummyWriteProc,
Comment => {
Notes => 'comment embedded in JPEG, GIF89a or PPM/PGM/PBM image',
Writable => 1,
WriteGroup => 'Comment',
Priority => 0,
},
Directory => {
Writable => 1,
Protected => 1,
ValueConvInv => '$_=$val; tr/\\\\/\//; m{[^/]$} and $_ .= "/"; $_',
},
FileName => {
Writable => 1,
Protected => 1,
ValueConvInv => '$val=~tr/\\\\/\//; $val',
},
FileSize => {
PrintConv => sub {
my $val = shift;
$val < 2048 and return "$val bytes";
$val < 10240 and return sprintf('%.1f kB', $val / 1024);
$val < 2097152 and return sprintf('%.0f kB', $val / 1024);
$val < 10485760 and return sprintf('%.1f MB', $val / 1048576);
return sprintf('%.0f MB', $val / 1048576);
},
},
FileType => { },
FileModifyDate => {
Description => 'File Modification Date/Time',
Notes => 'the filesystem modification time',
Groups => { 2 => 'Time' },
Writable => 1,
Protected => 1,
Shift => 'Time',
ValueConv => 'ConvertUnixTime($val,"local")',
ValueConvInv => 'GetUnixTime($val,"local")',
PrintConv => '$self->ConvertDateTime($val)',
PrintConvInv => '$self->InverseDateTime($val)',
},
MIMEType => { },
ImageWidth => { },
ImageHeight => { },
XResolution => { },
YResolution => { },
MaxVal => { },
EXIF => {
Notes => 'the full EXIF data block for JPEG images',
Groups => { 0 => 'EXIF' },
Binary => 1,
},
ICC_Profile => {
Notes => 'the full ICC_Profile data block',
Groups => { 0 => 'ICC_Profile' },
Flags => ['Writable' ,'Protected', 'Binary'],
WriteCheck => q{
require Image::ExifTool::ICC_Profile;
return Image::ExifTool::ICC_Profile::ValidateICC(\$val);
},
},
XMP => {
Notes => 'the full XMP data block',
Groups => { 0 => 'XMP' },
Flags => [ 'Writable', 'Binary' ],
Priority => 0,
WriteCheck => q{
require Image::ExifTool::XMP;
return Image::ExifTool::XMP::CheckXMP($self, $tagInfo, \$val);
},
},
CanonVRD => {
Notes => 'the full Canon DPP VRD trailer block',
Groups => { 0 => 'CanonVRD' },
WriteGroup => 'MakerNotes',
Flags => ['Writable' ,'Protected', 'Binary'],
Permanent => 0,
WriteCheck => q{
return undef if $val =~ /^CANON OPTIONAL DATA\0/;
return 'Invalid CanonVRD data';
},
},
CurrentIPTCDigest => {
Notes => 'MD5 digest of IPTC data, computed if Digest::MD5 is available',
ValueConv => 'unpack("H*", $val)',
},
Encryption => { },
ExifByteOrder => {
Writable => 1,
Notes => 'only writable for newly created EXIF segments',
PrintConv => {
II => 'Little-endian (Intel, II)',
MM => 'Big-endian (Motorola, MM)',
},
},
ExifUnicodeByteOrder => {
Writable => 1,
Notes => q{
the EXIF specification is particularly vague about the byte ordering for
Unicode text, and different applications use different conventions. By
default ExifTool writes Unicode text in EXIF byte order, but this write-only
tag may be used to force a specific byte order
},
PrintConv => {
II => 'Little-endian (Intel, II)',
MM => 'Big-endian (Motorola, MM)',
},
},
ExifToolVersion => {
Description => 'ExifTool Version Number',
Groups => \%allGroupsExifTool,
},
GIFVersion => { },
Now => {
Groups => { 0 => 'ExifTool', 1 => 'ExifTool', 2 => 'Time' },
Notes => q{
used to set the value of a tag to the current date/time. Not generated unless
specified
},
ValueConv => q{
my @tm = localtime;
sprintf("%4d:%.2d:%.2d %.2d:%.2d:%.2d", $tm[5]+1900, $tm[4]+1, $tm[3],
$tm[2], $tm[1], $tm[0]);
},
PrintConv => '$self->ConvertDateTime($val)',
},
ID3Size => { },
Error => { Priority => 0, Groups => \%allGroupsExifTool },
Warning => { Priority => 0, Groups => \%allGroupsExifTool },
);
%Image::ExifTool::JPEG::yCbCrSubSampling = (
'1 1' => 'YCbCr4:4:4 (1 1)',
'2 1' => 'YCbCr4:2:2 (2 1)',
'2 2' => 'YCbCr4:2:0 (2 2)',
'4 1' => 'YCbCr4:1:1 (4 1)',
'4 2' => 'YCbCr4:1:0 (4 2)',
'1 2' => 'YCbCr4:4:0 (1 2)',
'1 4' => 'YCbCr4:4:1 (1 4)',
'2 4' => 'YCbCr4:2:1 (2 4)',
);
%Image::ExifTool::JPEG::SOF = (
GROUPS => { 0 => 'File', 1 => 'File', 2 => 'Image' },
NOTES => 'This information is extracted from the JPEG Start Of Frame segment.',
VARS => { NO_ID => 1 },
EncodingProcess => {
PrintHex => 1,
PrintConv => {
0x0 => 'Baseline DCT, Huffman coding',
0x1 => 'Extended sequential DCT, Huffman coding',
0x2 => 'Progressive DCT, Huffman coding',
0x3 => 'Lossless, Huffman coding',
0x5 => 'Sequential DCT, differential Huffman coding',
0x6 => 'Progressive DCT, differential Huffman coding',
0x7 => 'Lossless, Differential Huffman coding',
0x9 => 'Extended sequential DCT, arithmetic coding',
0xa => 'Progressive DCT, arithmetic coding',
0xb => 'Lossless, arithmetic coding',
0xd => 'Sequential DCT, differential arithmetic coding',
0xe => 'Progressive DCT, differential arithmetic coding',
0xf => 'Lossless, differential arithmetic coding',
}
},
BitsPerSample => { },
ImageHeight => { },
ImageWidth => { },
ColorComponents => { },
YCbCrSubSampling => {
Notes => 'calculated from components table',
PrintConv => \%Image::ExifTool::JPEG::yCbCrSubSampling,
},
);
%allTables = ( );
@tableOrder = ( );
my $didTagID;
%Image::ExifTool::Composite = (
GROUPS => { 0 => 'Composite', 1 => 'Composite' },
DID_TAG_ID => 1,
WRITE_PROC => \&DummyWriteProc,
);
%Image::ExifTool::JFIF::Main = (
PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData,
WRITE_PROC => \&Image::ExifTool::WriteBinaryData,
CHECK_PROC => \&Image::ExifTool::CheckBinaryData,
GROUPS => { 0 => 'JFIF', 1 => 'JFIF', 2 => 'Image' },
DATAMEMBER => [ 2, 3, 5 ],
0 => {
Name => 'JFIFVersion',
Format => 'int8u[2]',
PrintConv => 'sprintf("%d.%.2d", split(" ",$val))',
},
2 => {
Name => 'ResolutionUnit',
Writable => 1,
RawConv => '$$self{JFIFResolutionUnit} = $val',
PrintConv => {
0 => 'None',
1 => 'inches',
2 => 'cm',
},
Priority => -1,
},
3 => {
Name => 'XResolution',
Format => 'int16u',
Writable => 1,
Priority => -1,
RawConv => '$$self{JFIFXResolution} = $val',
},
5 => {
Name => 'YResolution',
Format => 'int16u',
Writable => 1,
Priority => -1,
RawConv => '$$self{JFIFYResolution} = $val',
},
);
%Image::ExifTool::JFIF::Extension = (
GROUPS => { 0 => 'JFIF', 1 => 'JFIF', 2 => 'Image' },
0x10 => {
Name => 'ThumbnailImage',
RawConv => '$self->ValidateImage(\$val,$tag)',
},
);
sub SetWarning($) { $evalWarning = $_[0]; }
sub GetWarning() { return $evalWarning; }
sub CleanWarning(;$)
{
my $str = shift;
unless (defined $str) {
return undef unless defined $evalWarning;
$str = $evalWarning;
}
$str = $1 if $str =~ /(.*) at /s;
$str =~ s/\s+$//s;
return $str;
}
sub new
{
local $_;
my $that = shift;
my $class = ref($that) || $that || 'Image::ExifTool';
my $self = bless {}, $class;
GetTagTable("Image::ExifTool::Exif::Main");
$self->ClearOptions();
$self->{VALUE} = { };
$self->{DEL_GROUP} = { };
$self->SetNewGroups(@defaultWriteGroups);
return $self;
}
sub ImageInfo($;@)
{
local $_;
my $self;
if (ref $_[0] and UNIVERSAL::isa($_[0],'Image::ExifTool')) {
$self = shift;
} else {
$self = new Image::ExifTool;
}
my %saveOptions = %{$self->{OPTIONS}};
$self->{FILENAME} = $self->{RAF} = undef;
$self->ParseArguments(@_);
$self->ExtractInfo(undef);
my $info = $self->GetInfo(undef);
$self->{OPTIONS} = \%saveOptions;
return $info;
}
sub Options($$;@)
{
local $_;
my $self = shift;
my $options = $$self{OPTIONS};
my $oldVal;
while (@_) {
my $param = shift;
$oldVal = $options->{$param};
last unless @_;
$options->{$param} = shift;
if ($param eq 'Exclude' and defined $options->{$param}) {
my @exclude;
my $val = $options->{$param};
if (ref $val eq 'ARRAY') {
@exclude = @$val;
} else {
@exclude = ($val);
}
ExpandShortcuts(\@exclude);
$options->{$param} = \@exclude;
}
}
return $oldVal;
}
sub ClearOptions($)
{
local $_;
my $self = shift;
$self->{OPTIONS} = {
Charset => 'UTF8',
Composite => 1,
Duplicates => 1,
HtmlDump => 0,
ListSep => ', ',
PrintConv => 1,
Sort => 'Input',
TextOut => \*STDOUT,
Unknown => 0,
Verbose => 0,
};
}
sub ExtractInfo($;@)
{
local $_;
my $self = shift;
my $options = $self->{OPTIONS};
my (%saveOptions, $reEntry);
if (ref $_[0] eq 'SCALAR' and ref $_[1] eq 'HASH' and $_[1]->{ReEntry}) {
$self->{RAF} = new File::RandomAccess($_[0]);
$reEntry = 1;
} elsif (defined $_[0] or $options->{HtmlDump}) {
%saveOptions = %$options;
$self->Options(Duplicates => 1) if $options->{HtmlDump};
if (defined $_[0]) {
$self->{FILENAME} = undef;
$self->{RAF} = undef;
$self->ParseArguments(@_);
}
}
unless ($reEntry) {
$self->Init();
delete $self->{MAKER_NOTE_FIXUP};
delete $self->{MAKER_NOTE_BYTE_ORDER};
delete $self->{DONE_ID3};
$self->FoundTag('ExifToolVersion', "$VERSION$RELEASE");
$self->FoundTag('Now', 0) if $self->{REQ_TAG_LOOKUP}->{now} or $self->{TAGS_FROM_FILE};
}
my $filename = $self->{FILENAME};
my $raf = $self->{RAF};
local *EXIFTOOL_FILE;
unless ($raf) {
if (defined $filename and $filename ne '') {
unless ($filename eq '-') {
my $name = $filename;
$name =~ /\|$/ and $name =~ s/.*?"(.*)".*/$1/;
my $dir;
if (eval 'require File::Basename') {
$dir = File::Basename::dirname($name);
$name = File::Basename::basename($name);
} else {
$name =~ tr/\\/\//;
if ($name =~ s/(.*)\///) {
$dir = length($1) ? $1 : '/';
}
}
$self->FoundTag('FileName', $name);
$self->FoundTag('Directory', $dir) if defined $dir and length $dir;
}
if (open(EXIFTOOL_FILE, $filename)) {
my $filePt = \*EXIFTOOL_FILE;
$raf = new File::RandomAccess($filePt);
$raf->{TESTED} = -1 if $filename eq '-' or $filename =~ /\|$/;
$self->{RAF} = $raf;
} else {
$self->Error('Error opening file');
}
} else {
$self->Error('No file specified');
}
}
if ($raf) {
if ($reEntry) {
} elsif (not $raf->{FILE_PT}) {
$self->FoundTag('FileSize', length ${$raf->{BUFF_PT}});
} elsif (-f $raf->{FILE_PT}) {
my $fileSize = -s _;
my $fileTime = -M _;
$self->FoundTag('FileSize', $fileSize) if defined $fileSize;
$self->FoundTag('FileModifyDate', $^T - $fileTime*(24*3600)) if defined $fileTime;
}
my $tiffType;
$self->{FILE_EXT} = GetFileExtension($filename);
my @fileTypeList = GetFileType($filename);
if (@fileTypeList) {
my $pat = join '|', @fileTypeList;
push @fileTypeList, grep(!/^($pat)$/, @fileTypes);
$tiffType = $self->{FILE_EXT};
} else {
@fileTypeList = @fileTypes;
$tiffType = 'TIFF';
}
push @fileTypeList, '';
$raf->BinMode();
my $pos = $raf->Tell();
my %dirInfo = ( RAF => $raf, Base => $pos );
my ($type, $buff, $seekErr);
$raf->Read($buff, 1024) or $buff = '';
$raf->Seek($pos, 0) or $seekErr = 1;
until ($seekErr) {
$type = shift @fileTypeList;
if ($type) {
next if $magicNumber{$type} and $buff !~ /^$magicNumber{$type}/s;
} else {
last unless defined $type;
next unless $buff =~ /(\xff\xd8\xff|MM\0\x2a|II\x2a\0)/g;
$type = ($1 eq "\xff\xd8\xff") ? 'JPEG' : 'TIFF';
my $skip = pos($buff) - length($1);
$dirInfo{Base} = $pos + $skip;
$raf->Seek($pos + $skip, 0) or $seekErr = 1, last;
$self->Warn("Skipped unknown $skip byte header");
}
$self->{FILE_TYPE} = $type;
$dirInfo{Parent} = ($type eq 'TIFF') ? $tiffType : $type;
my $module = $moduleName{$type};
$module = $type unless defined $module;
my $func = "Process$type";
if ($module) {
require "Image/ExifTool/$module.pm";
$func = "Image::ExifTool::${module}::$func";
}
no strict 'refs';
&$func($self, \%dirInfo) and last;
$raf->Seek($pos, 0) or $seekErr = 1, last;
}
if ($seekErr) {
$self->Error('Error seeking in file');
} elsif ($self->Options('ScanForXMP') and (not defined $type or
(not $self->Options('FastScan') and not $$self{FoundXMP})))
{
$raf->Seek($pos, 0);
Image::ExifTool::XMP::ScanForXMP($self, $raf) and $type = '';
}
unless (defined $type) {
$self->Error(GetFileType($filename) ?
'File format error' : 'Unknown file type');
}
if (defined $self->{EXIF_DATA} and $self->{REQ_TAG_LOOKUP}->{exif}) {
$self->FoundTag('EXIF', $self->{EXIF_DATA});
}
$self->BuildCompositeTags() if $options->{Composite};
if ($self->{HTML_DUMP}) {
$raf->Seek(0, 2);
$self->{HTML_DUMP}->FinishTiffDump($self, $raf->Tell());
my $pos = $options->{HtmlDumpBase};
$pos = ($self->{FIRST_EXIF_POS} || 0) unless defined $pos;
my $dataPt = defined $self->{EXIF_DATA} ? \$self->{EXIF_DATA} : undef;
undef $dataPt if defined $self->{EXIF_POS} and $pos != $self->{EXIF_POS};
my $success = $self->{HTML_DUMP}->Print($raf, $dataPt, $pos,
$options->{TextOut}, $options->{HtmlDump},
$self->{FILENAME} ? "HTML Dump ($self->{FILENAME})" : 'HTML Dump');
$self->Warn("Error reading $self->{HTML_DUMP}->{ERROR}") if $success < 0;
}
$raf->Close() if $filename;
}
%saveOptions and $self->{OPTIONS} = \%saveOptions;
return exists $self->{VALUE}->{Error} ? 0 : 1;
}
sub GetInfo($;@)
{
local $_;
my $self = shift;
my %saveOptions;
unless (@_ and not defined $_[0]) {
%saveOptions = %{$self->{OPTIONS}};
$self->{FILENAME} = '' unless defined $self->{FILENAME};
$self->ParseArguments(@_);
}
my $rtnTags = $self->SetFoundTags();
my (%info, %ignored);
my $conv = $self->{OPTIONS}->{PrintConv} ? 'PrintConv' : 'ValueConv';
foreach (@$rtnTags) {
my $val = $self->GetValue($_, $conv);
defined $val or $ignored{$_} = 1, next;
$info{$_} = $val;
}
my $reqTags = $self->{REQUESTED_TAGS} || [ ];
if (%ignored and not @$reqTags) {
my @goodTags;
foreach (@$rtnTags) {
push @goodTags, $_ unless $ignored{$_};
}
$rtnTags = $self->{FOUND_TAGS} = \@goodTags;
}
if ($self->{IO_TAG_LIST}) {
my $sortOrder = $self->{OPTIONS}->{Sort};
unless (@$reqTags or ($sortOrder and $sortOrder ne 'Input')) {
$sortOrder = 'File';
}
@{$self->{IO_TAG_LIST}} = $self->GetTagList($rtnTags, $sortOrder);
}
%saveOptions and $self->{OPTIONS} = \%saveOptions;
return \%info;
}
sub CombineInfo($;@)
{
local $_;
my $self = shift;
my (%combinedInfo, $info);
if ($self->{OPTIONS}->{Duplicates}) {
while ($info = shift) {
my $key;
foreach $key (keys %$info) {
$combinedInfo{$key} = $$info{$key};
}
}
} else {
my (%haveInfo, $tag);
while ($info = shift) {
foreach $tag (keys %$info) {
my $tagName = GetTagName($tag);
next if $haveInfo{$tagName};
$haveInfo{$tagName} = 1;
$combinedInfo{$tag} = $$info{$tag};
}
}
}
return \%combinedInfo;
}
sub GetTagList($;$$)
{
local $_;
my ($self, $info, $sortOrder) = @_;
my $foundTags;
if (ref $info eq 'HASH') {
my @tags = keys %$info;
$foundTags = \@tags;
} elsif (ref $info eq 'ARRAY') {
$foundTags = $info;
}
my $fileOrder = $self->{FILE_ORDER};
if ($foundTags) {
foreach (@$foundTags) {
next if defined $$fileOrder{$_};
$$fileOrder{$_} = 999;
}
} else {
$sortOrder = $info if $info and not $sortOrder;
$foundTags = $self->{FOUND_TAGS} || $self->SetFoundTags() or return undef;
}
$sortOrder or $sortOrder = $self->{OPTIONS}->{Sort};
return @$foundTags unless $sortOrder and $sortOrder ne 'Input';
if ($sortOrder eq 'Alpha') {
return sort @$foundTags;
} elsif ($sortOrder =~ /^Group(\d*)/) {
my $family = $1 || 0;
my (%groupCount, %groupOrder);
my $numGroups = 0;
my $tag;
foreach $tag (sort { $$fileOrder{$a} <=> $$fileOrder{$b} } @$foundTags) {
my $group = $self->GetGroup($tag, $family);
my $num = $groupCount{$group};
$num or $num = $groupCount{$group} = ++$numGroups;
$groupOrder{$tag} = $num;
}
return sort { $groupOrder{$a} <=> $groupOrder{$b} or
$$fileOrder{$a} <=> $$fileOrder{$b} } @$foundTags;
} else {
return sort { $$fileOrder{$a} <=> $$fileOrder{$b} } @$foundTags;
}
}
sub GetFoundTags($;$)
{
local $_;
my ($self, $sortOrder) = @_;
my $foundTags = $self->{FOUND_TAGS} || $self->SetFoundTags() or return undef;
return $self->GetTagList($foundTags, $sortOrder);
}
sub GetRequestedTags($)
{
local $_;
return @{$_[0]->{REQUESTED_TAGS}};
}
sub GetValue($$;$)
{
local $_;
my ($self, $tag, $type) = @_;
my $value = $self->{VALUE}->{$tag};
return wantarray ? () : undef unless defined $value;
my (@convTypes, $tagInfo);
$type or $type = $self->{OPTIONS}->{PrintConv} ? 'PrintConv' : 'ValueConv';
unless ($type eq 'Raw') {
$tagInfo = $self->{TAG_INFO}->{$tag};
push @convTypes, 'ValueConv';
push @convTypes, 'PrintConv' unless $type eq 'ValueConv';
}
my (@val, @prt, @raw, $convType, $valueConv);
foreach $convType (@convTypes) {
last if ref $value eq 'SCALAR';
my $conv = $$tagInfo{$convType};
unless (defined $conv) {
if ($convType eq 'ValueConv') {
next unless $$tagInfo{Binary};
$conv = '\$val';
} else {
next unless defined($conv = $tagInfo->{Table}->{PRINT_CONV});
}
}
$valueConv = $value if $type eq 'Both' and $convType eq 'PrintConv';
my ($i, $val, $vals, @values, $convList);
if (ref $conv eq 'ARRAY') {
$convList = $conv;
$conv = $$convList[0];
my @valList = split ' ', $value;
my $relist = $$tagInfo{Relist};
if ($relist) {
my (@newList, $oldIndex);
foreach $oldIndex (@$relist) {
my ($newVal, @join);
if (ref $oldIndex) {
foreach (@$oldIndex) {
push @join, $valList[$_] if defined $valList[$_];
}
$newVal = join(' ', @join) if @join;
} else {
$newVal = $valList[$oldIndex];
}
push @newList, $newVal if defined $newVal;
}
$value = \@newList;
} else {
$value = \@valList;
}
}
if (ref $value eq 'ARRAY') {
$i = 0;
$vals = $value;
$val = $$vals[0];
} else {
$val = $value;
}
for (;;) {
if (defined $conv) {
if (ref $val eq 'HASH' and not @val) {
foreach (keys %$val) {
$raw[$_] = $self->{VALUE}->{$$val{$_}};
($val[$_], $prt[$_]) = $self->GetValue($$val{$_}, 'Both');
next if defined $val[$_] or not $tagInfo->{Require}->{$_};
return wantarray ? () : undef;
}
$val = ref $conv eq 'CODE' ? \@val : $val[0];
}
if (ref $conv eq 'HASH') {
unless (defined($value = $$conv{$val})) {
if ($$conv{BITMASK}) {
$value = DecodeBits($val, $$conv{BITMASK});
} elsif (not $$conv{OTHER} or
not defined($value = &{$$conv{OTHER}}($val, undef, $conv)))
{
if (($$tagInfo{PrintHex} or
($$tagInfo{Mask} and not defined $$tagInfo{PrintHex}))
and $val and IsInt($val) and $convType eq 'PrintConv')
{
$val = sprintf('0x%x',$val);
}
$value = "Unknown ($val)";
}
}
} else {
local $SIG{'__WARN__'} = \&SetWarning;
undef $evalWarning;
if (ref $conv eq 'CODE') {
$value = &$conv($val, $self);
} else {
$value = eval $conv;
$@ and $evalWarning = $@;
}
$self->Warn("$convType $tag: " . CleanWarning()) if $evalWarning;
}
} else {
$value = $val;
}
last unless $vals;
push @values, $value if defined $value;
if (++$i >= scalar(@$vals)) {
$value = \@values if @values;
last;
}
$val = $$vals[$i];
$conv = $$convList[$i] if $convList;
}
return wantarray ? () : undef unless defined $value;
if ($convList and ref $value eq 'ARRAY') {
$value = join($convType eq 'PrintConv' ? '; ' : ' ', @$value);
}
}
if ($type eq 'Both') {
$valueConv = $value unless defined $valueConv;
return ($valueConv, $value);
}
if (ref $value eq 'ARRAY') {
return @$value if wantarray;
return $value if @convTypes < 2 or $self->{OPTIONS}->{List};
$value = join $self->{OPTIONS}->{ListSep}, @$value;
}
return $value;
}
sub GetTagID($$)
{
local $_;
my ($self, $tag) = @_;
my $tagInfo = $self->{TAG_INFO}->{$tag};
if ($tagInfo) {
GenerateAllTagIDs();
defined $$tagInfo{TagID} and return $$tagInfo{TagID};
}
return '';
}
sub GetDescription($$)
{
local $_;
my ($self, $tag) = @_;
my $tagInfo = $self->{TAG_INFO}->{$tag};
my $desc;
$desc = $$tagInfo{Description} if $tagInfo;
unless ($desc) {
$desc = MakeDescription(GetTagName($tag));
$$tagInfo{Description} = $desc if $tagInfo;
}
return $desc;
}
sub GetGroup($$;$)
{
local $_;
my ($self, $tag, $family) = @_;
my ($tagInfo, @groups, $extra);
if (ref $tag eq 'HASH') {
$tagInfo = $tag;
$tag = $tagInfo->{Name};
} else {
$tagInfo = $self->{TAG_INFO}->{$tag} or return '';
}
my $groups = $$tagInfo{Groups};
unless ($$tagInfo{GotGroups}) {
my $tagTablePtr = $$tagInfo{Table};
if ($tagTablePtr) {
$groups or $groups = $$tagInfo{Groups} = { };
foreach (keys %{$$tagTablePtr{GROUPS}}) {
$$groups{$_} or $$groups{$_} = $tagTablePtr->{GROUPS}->{$_};
}
}
$$tagInfo{GotGroups} = 1;
}
if (defined $family and $family >= 0) {
return $$groups{$family} || 'Other' unless $family == 1;
$groups[$family] = $$groups{$family};
} else {
return $$groups{0} unless wantarray;
foreach (0..2) { $groups[$_] = $$groups{$_}; }
}
if ($extra = $self->{GROUP1}->{$tag}) {
if ($extra =~ /^\+(.*)/) {
$groups[1] .= $1;
} else {
$groups[1] = $extra;
}
}
if ($family) {
return $groups[1] if $family == 1;
if ($groups[1] =~ /^MIE(\d*)-(.+?)(\d*)$/) {
push @groups, 'MIE' . ($1 || '1');
push @groups, 'MIE' . ($1 ? '' : '1') . "-$2$3";
push @groups, "MIE$1-$2" . ($3 ? '' : '1');
push @groups, 'MIE' . ($1 ? '' : '1') . "-$2" . ($3 ? '' : '1');
}
}
return @groups;
}
sub GetGroups($;$$)
{
local $_;
my $self = shift;
my $info = shift;
my $family;
if (ref $info ne 'HASH') {
$family = $info;
$info = $self->{VALUE};
} else {
$family = shift;
}
$family = 0 unless defined $family;
my ($tag, %groups);
foreach $tag (keys %$info) {
$groups{ $self->GetGroup($tag, $family) } = 1;
}
return sort keys %groups;
}
sub SetNewGroups($;@)
{
local $_;
my ($self, @groups) = @_;
@groups or @groups = @defaultWriteGroups;
my $count = @groups;
my %priority;
foreach (@groups) {
$priority{lc($_)} = $count--;
}
$priority{file} = 10;
$priority{composite} = 10;
$self->{WRITE_PRIORITY} = \%priority;
$self->{WRITE_GROUPS} = \@groups;
}
sub BuildCompositeTags($)
{
local $_;
my $self = shift;
if (defined %UserDefined and $UserDefined{'Image::ExifTool::Composite'}) {
AddCompositeTags($UserDefined{'Image::ExifTool::Composite'},1);
delete $UserDefined{'Image::ExifTool::Composite'};
}
my @tagList = sort keys %Image::ExifTool::Composite;
my %tagsUsed;
my $rawValue = $self->{VALUE};
for (;;) {
my %notBuilt;
foreach (@tagList) {
$notBuilt{$_} = 1;
}
my @deferredTags;
my $tag;
COMPOSITE_TAG:
foreach $tag (@tagList) {
next if $specialTags{$tag};
my $tagInfo = $self->GetTagInfo(\%Image::ExifTool::Composite, $tag);
next unless $tagInfo;
my (%tagKey, $type, $found);
foreach $type ('Require','Desire') {
my $req = $$tagInfo{$type} or next;
my $index;
foreach $index (keys %$req) {
my $reqTag = $$req{$index};
if ($reqTag =~ /(.+?):(.+)/) {
my ($reqGroup, $name) = ($1, $2);
my $family;
$family = $1 if $reqGroup =~ s/^(\d+)//;
my $i = 0;
for (;;++$i) {
$reqTag = $name;
$reqTag .= " ($i)" if $i;
last unless defined $$rawValue{$reqTag};
my @groups = $self->GetGroup($reqTag, $family);
last if grep { $reqGroup eq $_ } @groups;
}
} elsif ($notBuilt{$reqTag}) {
push @deferredTags, $tag;
next COMPOSITE_TAG;
}
if (defined $$rawValue{$reqTag}) {
$found = 1;
} else {
$type eq 'Require' and next COMPOSITE_TAG;
}
$tagKey{$index} = $reqTag;
}
}
delete $notBuilt{$tag};
next unless $found;
foreach (keys %tagKey) {
next unless $Image::ExifTool::Composite{$tagKey{$_}};
my $keyRef = \$tagKey{$_};
$tagsUsed{$$keyRef} or $tagsUsed{$$keyRef} = [ ];
push @{$tagsUsed{$$keyRef}}, $keyRef;
}
my $key = $self->FoundTag($tagInfo, \%tagKey);
next unless defined $key and $tagsUsed{$key};
foreach (@{$tagsUsed{$key}}) {
$$_ = $self->{MOVED_KEY};
}
delete $tagsUsed{$key};
}
last unless @deferredTags;
if (@deferredTags == @tagList) {
warn "Circular dependency in Composite tags\n";
last;
}
@tagList = @deferredTags;
}
}
sub GetTagName($)
{
local $_;
$_[0] =~ /^(\S+)/;
return $1;
}
sub GetShortcuts()
{
local $_;
return sort keys %Image::ExifTool::Shortcuts::Main;
}
sub GetFileType(;$$)
{
local $_;
my ($file, $desc) = @_;
return sort keys %fileTypeLookup unless defined $file;
my $fileType;
my $fileExt = GetFileExtension($file);
$fileExt = uc($file) unless $fileExt;
$fileExt and $fileType = $fileTypeLookup{$fileExt};
return $$fileType[1] if $desc;
$fileType = $$fileType[0];
if (wantarray) {
return () unless $fileType;
return @$fileType if ref $fileType eq 'ARRAY';
} elsif ($fileType) {
$fileType = $fileExt if ref $fileType eq 'ARRAY';
}
return $fileType;
}
sub CanWrite($)
{
local $_;
my $file = shift or return undef;
my $type = GetFileType($file) or return undef;
if ($noWriteFile{$type}) {
my $ext = GetFileExtension($file) || uc($file);
return grep(/^$ext$/, @{$noWriteFile{$type}}) ? 0 : 1 if $ext;
}
return scalar(grep /^$type$/, @writeTypes);
}
sub CanCreate($)
{
local $_;
my $file = shift or return undef;
my $type = GetFileType($file) or return undef;
return scalar(grep /^$type$/, @createTypes);
}
sub Init($)
{
local $_;
my $self = shift;
foreach (keys %$self) {
/[a-z]/ and delete $self->{$_};
}
delete $self->{FOUND_TAGS};
delete $self->{EXIF_DATA};
delete $self->{EXIF_POS};
delete $self->{FIRST_EXIF_POS};
delete $self->{EXIF_BYTE_ORDER};
delete $self->{HTML_DUMP};
$self->{BASE} = 0;
$self->{FILE_ORDER} = { };
$self->{VALUE} = { };
$self->{TAG_INFO} = { };
$self->{GROUP1} = { };
$self->{PRIORITY} = { };
$self->{LIST_TAGS} = { };
$self->{PROCESSED} = { };
$self->{DIR_COUNT} = { };
$self->{NUM_FOUND} = 0;
$self->{CHANGED} = 0;
$self->{INDENT} = ' ';
$self->{PRIORITY_DIR} = '';
$self->{TIFF_TYPE} = '';
$self->{Make} = '';
$self->{Model} = '';
$self->{CameraType} = '';
if ($self->Options('HtmlDump')) {
$self->{HTML_DUMP} = new Image::ExifTool::HtmlDump;
}
$self->{OPTIONS}->{TextOut} = \*STDOUT unless ref $self->{OPTIONS}->{TextOut};
}
sub ParseArguments($;@)
{
my $self = shift;
my $options = $self->{OPTIONS};
my @exclude;
my @oldGroupOpts = grep /^Group/, keys %{$self->{OPTIONS}};
my $wasExcludeOpt;
$self->{REQUESTED_TAGS} = [ ];
$self->{REQ_TAG_LOOKUP} = { };
$self->{IO_TAG_LIST} = undef;
while (@_) {
my $arg = shift;
if (ref $arg) {
if (ref $arg eq 'ARRAY') {
$self->{IO_TAG_LIST} = $arg;
foreach (@$arg) {
if (/^-(.*)/) {
push @exclude, $1;
} else {
push @{$self->{REQUESTED_TAGS}}, $_;
}
}
} elsif (ref $arg eq 'HASH') {
my $opt;
foreach $opt (keys %$arg) {
if (@oldGroupOpts and $opt =~ /^Group/) {
foreach (@oldGroupOpts) {
delete $options->{$_};
}
undef @oldGroupOpts;
}
$options->{$opt} = $$arg{$opt};
$opt eq 'Exclude' and $wasExcludeOpt = 1;
}
} elsif (ref $arg eq 'SCALAR' or UNIVERSAL::isa($arg,'GLOB')) {
next if defined $self->{RAF};
if (ref $arg eq 'SCALAR' and eval 'require Encode; Encode::is_utf8($$arg)') {
my $buff = pack('C*', unpack('U0U*', $$arg));
$arg = \$buff;
}
$self->{RAF} = new File::RandomAccess($arg);
$self->{FILENAME} = '';
} elsif (UNIVERSAL::isa($arg, 'File::RandomAccess')) {
$self->{RAF} = $arg;
$self->{FILENAME} = '';
} else {
warn "Don't understand ImageInfo argument $arg\n";
}
} elsif (defined $self->{FILENAME}) {
if ($arg =~ /^-(.*)/) {
push @exclude, $1;
} else {
push @{$self->{REQUESTED_TAGS}}, $arg;
}
} else {
$self->{FILENAME} = $arg;
}
}
if (@{$self->{REQUESTED_TAGS}}) {
ExpandShortcuts($self->{REQUESTED_TAGS});
foreach (@{$self->{REQUESTED_TAGS}}) {
$self->{REQ_TAG_LOOKUP}->{lc(/.+?:(.+)/ ? $1 : $_)} = 1;
}
}
if (@exclude or $wasExcludeOpt) {
if ($options->{Exclude}) {
if (ref $options->{Exclude} eq 'ARRAY') {
push @exclude, @{$options->{Exclude}};
} else {
push @exclude, $options->{Exclude};
}
}
$options->{Exclude} = \@exclude;
ExpandShortcuts($options->{Exclude});
}
}
sub SetFoundTags($)
{
my $self = shift;
my $options = $self->{OPTIONS};
my $reqTags = $self->{REQUESTED_TAGS} || [ ];
my $duplicates = $options->{Duplicates};
my $exclude = $options->{Exclude};
my $fileOrder = $self->{FILE_ORDER};
my @groupOptions = sort grep /^Group/, keys %$options;
my $doDups = $duplicates || $exclude || @groupOptions;
my ($tag, $rtnTags);
if (@$reqTags) {
$rtnTags or $rtnTags = [ ];
my $tagHash = $self->{VALUE};
my $reqTag;
foreach $reqTag (@$reqTags) {
my (@matches, $group, $family, $allGrp, $allTag);
if ($reqTag =~ /^(\d+)?(.+?):(.+)/) {
($family, $group, $tag) = ($1, $2, $3);
if ($group =~ /^(\*|all)$/i) {
$allGrp = 1;
} elsif ($group !~ /^[-\w]+$/) {
$self->Warn("Invalid group name '$group'");
$group = 'invalid';
}
$family = -1 unless defined $family;
} else {
$tag = $reqTag;
$family = -1;
}
if (defined $tagHash->{$reqTag} and not $doDups) {
$matches[0] = $tag;
} elsif ($tag =~ /^(\*|all)$/i) {
if ($doDups or $allGrp) {
@matches = keys %$tagHash;
} else {
@matches = grep(!/ /, keys %$tagHash);
}
next unless @matches;
$allTag = 1;
} elsif ($doDups or defined $group) {
@matches = grep(/^$tag(\s|$)/i, keys %$tagHash);
} elsif ($tag =~ /^[-\w]+$/) {
($matches[0]) = grep /^$tag$/i, keys %$tagHash;
defined $matches[0] or undef @matches;
} else {
$self->Warn("Invalid tag name '$tag'");
}
if (defined $group and not $allGrp) {
my @grpMatches;
foreach (@matches) {
my @groups = $self->GetGroup($_, $family);
next unless grep /^$group$/i, @groups;
push @grpMatches, $_;
}
@matches = @grpMatches;
next unless @matches or not $allTag;
}
if (@matches > 1) {
@matches = sort { $$fileOrder{$a} <=> $$fileOrder{$b} } @matches;
unless ($doDups or $allTag or $allGrp) {
$tag = shift @matches;
my $oldPriority = $self->{PRIORITY}->{$tag} || 1;
foreach (@matches) {
my $priority = $self->{PRIORITY}->{$_};
$priority = 1 unless defined $priority;
next unless $priority >= $oldPriority;
$tag = $_;
$oldPriority = $priority || 1;
}
@matches = ( $tag );
}
} elsif (not @matches) {
$matches[0] = "$tag (0)";
$self->{FILE_ORDER}->{$matches[0]} = 999;
}
push @$rtnTags, @matches;
}
} else {
my @allTags;
if ($doDups) {
@allTags = keys %{$self->{VALUE}};
} else {
foreach (keys %{$self->{VALUE}}) {
push @allTags, $_ unless / /;
}
}
$rtnTags = \@allTags;
}
while (($exclude or @groupOptions) and @$rtnTags) {
if ($exclude) {
my @filteredTags;
EX_TAG: foreach $tag (@$rtnTags) {
my $tagName = GetTagName($tag);
my @matches = grep /(^|:)($tagName|\*|all)$/i, @$exclude;
foreach (@matches) {
next EX_TAG unless /^(\d+)?(.+?):/;
my ($family, $group) = ($1, $2);
next EX_TAG if $group =~ /^(\*|all)$/i;
$family = -1 unless defined $family;
my @groups = $self->GetGroup($tag, $family);
next EX_TAG if grep /^$group$/i, @groups;
}
push @filteredTags, $tag;
}
$rtnTags = \@filteredTags;
last if $duplicates and not @groupOptions;
}
my (%keepTags, %wantGroup, $family, $groupOpt);
my $allGroups = 1;
my $wantOrder = 0;
foreach $groupOpt (@groupOptions) {
$groupOpt =~ /^Group(\d*)/ or next;
$family = $1 || 0;
$wantGroup{$family} or $wantGroup{$family} = { };
my $groupList;
if (ref $options->{$groupOpt} eq 'ARRAY') {
$groupList = $options->{$groupOpt};
} else {
$groupList = [ $options->{$groupOpt} ];
}
foreach (@$groupList) {
++$wantOrder;
my ($groupName, $want);
if (/^-(.*)/) {
$groupName = $1;
$want = 0;
} else {
$groupName = $_;
$want = $wantOrder;
$allGroups = 0;
}
$wantGroup{$family}->{$groupName} = $want;
}
}
my (@tags, %bestTag);
GR_TAG: foreach $tag (@$rtnTags) {
my $wantTag = $allGroups;
foreach $family (keys %wantGroup) {
my $group = $self->GetGroup($tag, $family);
my $wanted = $wantGroup{$family}->{$group};
next unless defined $wanted;
next GR_TAG unless $wanted;
next if $wantTag and $wantTag < $wanted;
$wantTag = $wanted;
}
next unless $wantTag;
if ($duplicates) {
push @tags, $tag;
} else {
my $tagName = GetTagName($tag);
my $bestTag = $bestTag{$tagName};
if (defined $bestTag) {
next if $wantTag > $keepTags{$bestTag};
if ($wantTag == $keepTags{$bestTag}) {
if ($tag =~ / \((\d+)\)$/) {
my $tagNum = $1;
next if $bestTag !~ / \((\d+)\)$/ or $1 > $tagNum;
}
}
delete $keepTags{$bestTag};
}
$keepTags{$tag} = $wantTag;
$bestTag{$tagName} = $tag;
}
}
unless ($duplicates) {
foreach $tag (@$rtnTags) {
push @tags, $tag if $keepTags{$tag};
}
}
$rtnTags = \@tags;
last;
}
return $self->{FOUND_TAGS} = $rtnTags;
}
sub DoAutoLoad(@)
{
my $autoload = shift;
my @callInfo = split(/::/, $autoload);
my $file = 'Image/ExifTool/Write';
return if $callInfo[$#callInfo] eq 'DESTROY';
if (@callInfo == 4) {
$file .= "$callInfo[2].pl";
} else {
$file .= 'r.pl';
}
eval "require '$file'" or die "Error while attempting to call $autoload\n$@\n";
unless (defined &$autoload) {
my @caller = caller(0);
die "Undefined subroutine $autoload called at $caller[1] line $caller[2]\n";
}
no strict 'refs';
return &$autoload(@_);
}
sub AUTOLOAD
{
return DoAutoLoad($AUTOLOAD, @_);
}
sub Warn($$;$)
{
my ($self, $str, $ignorable) = @_;
if ($ignorable) {
return 0 if $self->{OPTIONS}->{IgnoreMinorErrors};
$str = "[minor] $str";
}
$self->FoundTag('Warning', $str);
return 1;
}
sub Error($$;$)
{
my ($self, $str, $ignorable) = @_;
if ($ignorable) {
if ($self->{OPTIONS}->{IgnoreMinorErrors}) {
$self->Warn($str);
return 0;
}
$str = "[minor] $str";
}
$self->FoundTag('Error', $str);
return 1;
}
sub ExpandShortcuts($)
{
my $tagList = shift || return;
my @expandedTags;
my ($entry, $tag, $excl);
foreach $entry (@$tagList) {
if (ref $entry) {
push @expandedTags, $entry;
next;
}
($excl, $tag) = $entry =~ /^(-?)(.*)/s;
my ($post, @post);
if ($tag =~ /(.+?)([-+]?[<>].+)/s and not $excl) {
($tag, $post) = ($1, $2);
if ($post =~ /^[-+]?>/ or $post !~ /\$/) {
my ($op, $p2, $t2) = ($post =~ /([-+]?[<>])(.+?:)?(.+)/);
$p2 = '' unless defined $p2;
my ($match) = grep /^\Q$t2\E$/i, keys %Image::ExifTool::Shortcuts::Main;
if ($match) {
foreach (@{$Image::ExifTool::Shortcuts::Main{$match}}) {
/^-/ and next;
if ($p2 and /(.+?:)(.+)/) {
push @post, "$op$_";
} else {
push @post, "$op$p2$_";
}
}
next unless @post;
$post = shift @post;
}
}
} else {
$post = '';
}
my $pre;
if ($tag =~ /(.+?:)(.+)/) {
($pre, $tag) = ($1, $2);
} else {
$pre = '';
}
for (;;) {
my ($match) = grep /^\Q$tag\E$/i, keys %Image::ExifTool::Shortcuts::Main;
if ($match) {
if ($excl) {
foreach (@{$Image::ExifTool::Shortcuts::Main{$match}}) {
/^-/ and next;
if ($pre and /(.+?:)(.+)/) {
push @expandedTags, "$excl$_";
} else {
push @expandedTags, "$excl$pre$_";
}
}
} elsif (length $pre or length $post) {
foreach (@{$Image::ExifTool::Shortcuts::Main{$match}}) {
/(-?)(.+?:)?(.+)/;
if ($2) {
push @expandedTags, "$_$post";
} else {
push @expandedTags, "$1$pre$3$post";
}
}
} else {
push @expandedTags, @{$Image::ExifTool::Shortcuts::Main{$match}};
}
} else {
push @expandedTags, "$excl$pre$tag$post";
}
last unless @post;
$post = shift @post;
}
}
@$tagList = @expandedTags;
}
sub AddCompositeTags($;$)
{
local $_;
my ($add, $overwrite) = @_;
my $module;
unless (ref $add) {
$module = $add;
$add .= '::Composite';
no strict 'refs';
$add = \%$add;
}
my $defaultGroups = $$add{GROUPS};
if ($defaultGroups) {
$defaultGroups->{0} or $defaultGroups->{0} = 'Composite';
$defaultGroups->{1} or $defaultGroups->{1} = 'Composite';
$defaultGroups->{2} or $defaultGroups->{2} = 'Other';
} else {
$defaultGroups = $$add{GROUPS} = { 0 => 'Composite', 1 => 'Composite', 2 => 'Other' };
}
SetupTagTable($add);
my $tagID;
foreach $tagID (keys %$add) {
next if $specialTags{$tagID};
my $tagInfo = $$add{$tagID};
my $tag = $$tagInfo{Name};
$$tagInfo{Module} = $module if $$tagInfo{Writable};
my ($t, $n, $type);
while ($Image::ExifTool::Composite{$tag} and not $overwrite) {
$n ? $n += 1 : $n = 2, $t = $tag;
$tag = "${t}_$n";
}
foreach $type ('Require','Desire') {
my $req = $$tagInfo{$type} or next;
$$tagInfo{$type} = { 0 => $req } if ref($req) ne 'HASH';
}
$$tagInfo{Table} = \%Image::ExifTool::Composite;
$Image::ExifTool::Composite{$tag} = $tagInfo;
my $groups = $$tagInfo{Groups};
$groups or $groups = $$tagInfo{Groups} = { };
foreach (keys %$defaultGroups) {
$$groups{$_} or $$groups{$_} = $$defaultGroups{$_};
}
$$tagInfo{GotGroups} = 1;
}
}
sub ExpandFlags($)
{
my $tagInfo = shift;
my $flags = $$tagInfo{Flags};
if (ref $flags eq 'ARRAY') {
foreach (@$flags) {
$$tagInfo{$_} = 1;
}
} elsif (ref $flags eq 'HASH') {
my $key;
foreach $key (keys %$flags) {
$$tagInfo{$key} = $$flags{$key};
}
} else {
$$tagInfo{$flags} = 1;
}
}
sub SetupTagTable($)
{
my $tagTablePtr = shift;
my $tagID;
foreach $tagID (TagTableKeys($tagTablePtr)) {
my @infoArray = GetTagInfoList($tagTablePtr,$tagID);
my $tagInfo;
foreach $tagInfo (@infoArray) {
$$tagInfo{Table} = $tagTablePtr;
my $tag = $$tagInfo{Name};
unless (defined $tag) {
$tag = $tagID;
$$tagInfo{Name} = ucfirst($tag);
}
$$tagInfo{Flags} and ExpandFlags($tagInfo);
}
}
}
sub IsFloat($) {
return 1 if $_[0] =~ /^[+-]?(?=\d|\.\d)\d*(\.\d*)?([Ee]([+-]?\d+))?$/;
return 0 unless $_[0] =~ /^[+-]?(?=\d|,\d)\d*(,\d*)?([Ee]([+-]?\d+))?$/;
$_[0] =~ tr/,/./;
return 1;
}
sub IsInt($) { return scalar($_[0] =~ /^[+-]?\d+$/); }
sub IsHex($) { return scalar($_[0] =~ /^(0x)?[0-9a-f]{1,8}$/i); }
sub RoundFloat($$)
{
my ($val, $sig) = @_;
$val == 0 and return 0;
my $sign = $val < 0 ? ($val=-$val, -1) : 1;
my $log = log($val) / log(10);
my $exp = int($log) - $sig + ($log > 0 ? 1 : 0);
return $sign * int(10 ** ($log - $exp) + 0.5) * 10 ** $exp;
}
sub ToFloat(@)
{
local $_;
foreach (@_) {
next unless defined $_;
$_ = /((?:[+-]?)(?=\d|\.\d)\d*(?:\.\d*)?(?:[Ee](?:[+-]?\d+))?)/ ? $1 + 0 : undef;
}
return $_;
}
my $swapBytes;
my $swapWords;
my $currentByteOrder = 'MM';
my %unpackMotorola = ( S => 'n', L => 'N', C => 'C', c => 'c' );
my %unpackIntel = ( S => 'v', L => 'V', C => 'C', c => 'c' );
my %unpackStd = %unpackMotorola;
sub SwapBytes($$)
{
return $_[0] unless $swapBytes;
my ($val, $bytes) = @_;
my $newVal = '';
$newVal .= substr($val, $bytes, 1) while $bytes--;
return $newVal;
}
sub SwapWords($)
{
return $_[0] unless $swapWords and length($_[0]) == 8;
return substr($_[0],4,4) . substr($_[0],0,4)
}
sub DoUnpackStd(@)
{
$_[2] and return unpack("x$_[2] $unpackStd{$_[0]}", ${$_[1]});
return unpack($unpackStd{$_[0]}, ${$_[1]});
}
sub DoPackStd(@)
{
my $val = pack($unpackStd{$_[0]}, $_[1]);
$_[2] and substr(${$_[2]}, $_[3], length($val)) = $val;
return $val;
}
sub DoUnpack(@)
{
my ($bytes, $template, $dataPt, $pos) = @_;
my $val;
if ($swapBytes) {
$val = '';
$val .= substr($$dataPt,$pos+$bytes,1) while $bytes--;
} else {
$val = substr($$dataPt,$pos,$bytes);
}
defined($val) or return undef;
return unpack($template,$val);
}
sub DoUnpackDbl(@)
{
my ($template, $dataPt, $pos) = @_;
my $val = substr($$dataPt,$pos,8);
defined($val) or return undef;
return unpack($template, SwapWords(SwapBytes($val, 8)));
}
sub Get8s($$) { return DoUnpackStd('c', @_); }
sub Get8u($$) { return DoUnpackStd('C', @_); }
sub Get16s($$) { return DoUnpack(2, 's', @_); }
sub Get16u($$) { return DoUnpackStd('S', @_); }
sub Get32s($$) { return DoUnpack(4, 'l', @_); }
sub Get32u($$) { return DoUnpackStd('L', @_); }
sub GetFloat($$) { return DoUnpack(4, 'f', @_); }
sub GetDouble($$) { return DoUnpackDbl('d', @_); }
sub GetRational32s($$)
{
my ($dataPt, $pos) = @_;
my $denom = Get16s($dataPt, $pos + 2) or return 'inf';
return RoundFloat(Get16s($dataPt,$pos) / $denom, 7);
}
sub GetRational32u($$)
{
my ($dataPt, $pos) = @_;
my $denom = Get16u($dataPt, $pos + 2) or return 'inf';
return RoundFloat(Get16u($dataPt,$pos) / $denom, 7);
}
sub GetRational64s($$)
{
my ($dataPt, $pos) = @_;
my $denom = Get32s($dataPt, $pos + 4) or return 'inf';
return RoundFloat(Get32s($dataPt,$pos) / $denom, 10);
}
sub GetRational64u($$)
{
my ($dataPt, $pos) = @_;
my $denom = Get32u($dataPt, $pos + 4) or return 'inf';
return RoundFloat(Get32u($dataPt,$pos) / $denom, 10);
}
sub GetFixed16s($$)
{
my ($dataPt, $pos) = @_;
my $val = Get16s($dataPt, $pos) / 0x100;
return int($val * 1000 + ($val<0 ? -0.5 : 0.5)) / 1000;
}
sub GetFixed16u($$)
{
my ($dataPt, $pos) = @_;
return int((Get16u($dataPt, $pos) / 0x100) * 1000 + 0.5) / 1000;
}
sub GetFixed32s($$)
{
my ($dataPt, $pos) = @_;
my $val = Get32s($dataPt, $pos) / 0x10000;
return int($val * 1e5 + ($val>0 ? 0.5 : -0.5)) / 1e5;
}
sub GetFixed32u($$)
{
my ($dataPt, $pos) = @_;
return int((Get32u($dataPt, $pos) / 0x10000) * 1e5 + 0.5) / 1e5;
}
sub Set8s(@) { return DoPackStd('c', @_); }
sub Set8u(@) { return DoPackStd('C', @_); }
sub Set16u(@) { return DoPackStd('S', @_); }
sub Set32u(@) { return DoPackStd('L', @_); }
sub GetByteOrder() { return $currentByteOrder; }
sub SetByteOrder($)
{
my $order = shift;
if ($order eq 'MM') {
%unpackStd = %unpackMotorola;
} elsif ($order eq 'II') {
%unpackStd = %unpackIntel;
} elsif ($order =~ /^Big/i) {
$order = 'MM';
%unpackStd = %unpackMotorola;
} elsif ($order =~ /^Little/i) {
$order = 'II';
%unpackStd = %unpackIntel;
} else {
return 0;
}
my $val = unpack('S','A ');
my $nativeOrder;
if ($val == 0x4120) {
$nativeOrder = 'MM';
} elsif ($val == 0x2041) {
$nativeOrder = 'II';
} else {
warn sprintf("Unknown native byte order! (pattern %x)\n",$val);
return 0;
}
$currentByteOrder = $order;
$swapBytes = ($order ne $nativeOrder);
my $pack1d = pack('d', 1);
$swapWords = ($pack1d eq "\0\0\x0f\xf3\0\0\0\0" or
$pack1d eq "\0\0\xf0\x3f\0\0\0\0");
return 1;
}
sub ToggleByteOrder()
{
SetByteOrder(GetByteOrder() eq 'II' ? 'MM' : 'II');
}
my %formatSize = (
int8s => 1,
int8u => 1,
int16s => 2,
int16u => 2,
int32s => 4,
int32u => 4,
int64s => 8,
int64u => 8,
rational32s => 4,
rational32u => 4,
rational64s => 8,
rational64u => 8,
fixed16s => 2,
fixed16u => 2,
fixed32s => 4,
fixed32u => 4,
float => 4,
double => 8,
extended => 10,
string => 1,
binary => 1,
'undef' => 1,
ifd => 4,
ifd8 => 8,
);
my %readValueProc = (
int8s => \&Get8s,
int8u => \&Get8u,
int16s => \&Get16s,
int16u => \&Get16u,
int32s => \&Get32s,
int32u => \&Get32u,
int64s => \&Get64s,
int64u => \&Get64u,
rational32s => \&GetRational32s,
rational32u => \&GetRational32u,
rational64s => \&GetRational64s,
rational64u => \&GetRational64u,
fixed16s => \&GetFixed16s,
fixed16u => \&GetFixed16u,
fixed32s => \&GetFixed32s,
fixed32u => \&GetFixed32u,
float => \&GetFloat,
double => \&GetDouble,
extended => \&GetExtended,
ifd => \&Get32u,
ifd8 => \&Get64u,
);
sub FormatSize($) { return $formatSize{$_[0]}; }
sub ReadValue($$$$$)
{
my ($dataPt, $offset, $format, $count, $size) = @_;
my $len = $formatSize{$format};
unless ($len) {
warn "Unknown format $format";
$len = 1;
}
unless ($count) {
return '' if defined $count or $size < $len;
$count = int($size / $len);
}
if ($len * $count > $size) {
$count = int($size / $len);
$count < 1 and return undef;
}
my @vals;
my $proc = $readValueProc{$format};
if ($proc) {
for (;;) {
push @vals, &$proc($dataPt, $offset);
last if --$count <= 0;
$offset += $len;
}
} else {
$vals[0] = substr($$dataPt, $offset, $count);
$vals[0] =~ s/\0.*//s if $format eq 'string';
}
return @vals if wantarray;
return join(' ', @vals) if @vals > 1;
return $vals[0];
}
sub UTF82Charset($$)
{
my ($self, $val) = @_;
if ($self->{OPTIONS}->{Charset} eq 'Latin' and $val =~ /[\x80-\xff]/) {
$val = Image::ExifTool::UTF82Unicode($val,'n',$self);
$val = Image::ExifTool::Unicode2Latin($val,'n',$self);
}
return $val;
}
sub Latin2Charset($$)
{
my ($self, $val) = @_;
if ($self->{OPTIONS}->{Charset} eq 'UTF8' and $val =~ /[\x80-\xff]/) {
$val = Image::ExifTool::Latin2Unicode($val,'n');
$val = Image::ExifTool::Unicode2UTF8($val,'n');
}
return $val;
}
sub DecodeBits($$;$)
{
my ($vals, $lookup, $bits) = @_;
$bits or $bits = 32;
my ($val, $i, @bitList);
my $num = 0;
foreach $val (split ' ', $vals) {
for ($i=0; $i<$bits; ++$i) {
next unless $val & (1 << $i);
my $n = $i + $num;
if (not $lookup) {
push @bitList, $n;
} elsif ($$lookup{$n}) {
push @bitList, $$lookup{$n};
} else {
push @bitList, "[$n]";
}
}
$num += $bits;
}
return '(none)' unless @bitList;
return join($lookup ? ', ' : ',', @bitList);
}
sub ValidateImage($$$)
{
my ($self, $imagePt, $tag) = @_;
return undef if $$imagePt eq 'none';
unless ($$imagePt =~ /^(Binary data|\xff\xd8\xff)/ or
$$imagePt =~ s/^.(\xd8\xff\xdb)/\xff$1/s or
$self->Options('IgnoreMinorErrors'))
{
if ($self->{REQ_TAG_LOOKUP}->{lc GetTagName($tag)}) {
$self->Warn("$tag is not a valid JPEG image",1);
return undef;
}
}
return $imagePt;
}
sub MakeDescription($;$)
{
my ($tag, $tagID) = @_;
my $desc = ucfirst($tag);
$desc =~ tr/_/ /;
$desc =~ s/([a-z])([A-Z\d])/$1 $2/g;
$desc =~ s/([A-Z])([A-Z][a-z])/$1 $2/g;
$desc =~ s/(\d)([A-Z]\S)/$1 $2/g;
$desc =~ s/ 0x ([\dA-Fa-f])/ 0x$1/g;
$desc .= ' ' . $tagID if defined $tagID;
return $desc;
}
sub Printable($;$)
{
my ($self, $outStr, $unlimited) = @_;
return '(undef)' unless defined $outStr;
$outStr =~ tr/\x01-\x1f\x7f-\xff/./;
$outStr =~ s/\x00//g;
if (length($outStr) > 60 and not $unlimited and $self->{OPTIONS}->{Verbose} < 4) {
$outStr = substr($outStr,0,54) . '[snip]';
}
return $outStr;
}
sub ConvertDateTime($$)
{
my ($self, $date) = @_;
my $dateFormat = $self->{OPTIONS}->{DateFormat};
if ($dateFormat) {
if ($date =~ /^(\d+):(\d+):(\d+)\s+(\d+):(\d+):(\d+)/ and eval 'require POSIX') {
$date = POSIX::strftime($dateFormat, $6, $5, $4, $3, $2-1, $1-1900);
} elsif ($self->{OPTIONS}->{StrictDate}) {
undef $date;
}
}
return $date;
}
sub TimeLocal(@)
{
my $tm = Time::Local::timelocal(@_);
if ($^O eq 'MSWin32') {
my @t2 = localtime($tm);
my $t2 = Time::Local::timelocal(@t2);
$tm += $tm - $t2;
}
return $tm;
}
sub TimeZoneString($)
{
my $min = shift;
my $sign = '+';
$min < 0 and $sign = '-', $min = -$min;
my $h = int($min / 60);
return sprintf('%s%.2d:%.2d', $sign, $h, $min - $h * 60);
}
sub ConvertUnixTime($;$)
{
my ($time, $local) = @_;
return '0000:00:00 00:00:00' if $time == 0;
my @tm = $local ? localtime($time) : gmtime($time);
my $str = sprintf("%4d:%.2d:%.2d %.2d:%.2d:%.2d",
$tm[5]+1900, $tm[4]+1, $tm[3], $tm[2], $tm[1], $tm[0]);
if ($local) {
my @gm = gmtime($time);
my $diff = $tm[2] * 60 + $tm[1] - ($gm[2] * 60 + $gm[1]);
if ($tm[3] != $gm[3]) {
$gm[3] = $tm[3] - ($tm[3]==1 ? 1 : -1) if abs($tm[3]-$gm[3]) != 1;
$diff += ($tm[3] - $gm[3]) * 24 * 60;
}
$str .= TimeZoneString($diff);
}
return $str;
}
sub GetUnixTime($;$)
{
my ($timeStr, $isLocal) = @_;
return 0 if $timeStr eq '0000:00:00 00:00:00';
my @tm = ($timeStr =~ /^(\d+):(\d+):(\d+)\s+(\d+):(\d+):(\d+)/);
return undef unless @tm == 6 and eval 'require Time::Local';
my $tzsec = 0;
if ($isLocal and $timeStr =~ /(?:Z|([-+])(\d+):(\d+))$/i) {
$tzsec = ($2 * 60 + $3) * ($1 eq '-' ? -60 : 60) if $1;
undef $isLocal;
}
$tm[0] -= 1900;
$tm[1] -= 1;
@tm = reverse @tm;
return $isLocal ? TimeLocal(@tm) : Time::Local::timegm(@tm) - $tzsec;
}
sub ConvertDuration($;$)
{
my $time = shift;
return $time unless IsFloat($time);
return '0 s' if $time == 0;
return sprintf('%.2f s', $time) if $time < 60;
my $str = '';
if ($time >= 3600) {
my $h = int($time / 3600);
$str = "$h:";
$time -= $h * 3600;
}
my $m = int($time / 60);
$time -= $m * 60;
return sprintf('%s%.2d:%.2d', $str, $m, int($time));
}
sub HtmlDump($$$$;$$)
{
my $self = shift;
my $pos = shift;
$pos += $$self{BASE} if $$self{BASE};
$$self{HTML_DUMP} and $self->{HTML_DUMP}->Add($pos, @_);
}
my %jpegMarker = (
0x01 => 'TEM',
0xc0 => 'SOF0',
0xc4 => 'DHT',
0xc8 => 'JPGA',
0xcc => 'DAC',
0xd0 => 'RST0',
0xd8 => 'SOI',
0xd9 => 'EOI',
0xda => 'SOS',
0xdb => 'DQT',
0xdc => 'DNL',
0xdd => 'DRI',
0xde => 'DHP',
0xdf => 'EXP',
0xe0 => 'APP0',
0xf0 => 'JPG0',
0xfe => 'COM',
);
sub JpegMarkerName($)
{
my $marker = shift;
my $markerName = $jpegMarker{$marker};
unless ($markerName) {
$markerName = $jpegMarker{$marker & 0xf0};
if ($markerName and $markerName =~ /^([A-Z]+)\d+$/) {
$markerName = $1 . ($marker & 0x0f);
} else {
$markerName = sprintf("marker 0x%.2x", $marker);
}
}
return $markerName;
}
sub IdentifyTrailer($;$)
{
my $raf = shift;
my $offset = shift || 0;
my $pos = $raf->Tell();
my ($buff, $type, $len);
while ($raf->Seek(-$offset, 2) and ($len = $raf->Tell()) > 0) {
$len = 64 if $len > 64;
$raf->Seek(-$len, 1) and $raf->Read($buff, $len) == $len or last;
if ($buff =~ /AXS(!|\*).{8}$/s) {
$type = 'AFCP';
} elsif ($buff =~ /\xa1\xb2\xc3\xd4$/) {
$type = 'FotoStation';
} elsif ($buff =~ /cbipcbbl$/) {
$type = 'PhotoMechanic';
} elsif ($buff =~ /^CANON OPTIONAL DATA\0/) {
$type = 'CanonVRD';
} elsif ($buff =~ /~\0\x04\0zmie~\0\0\x06.{4}[\x10\x18]\x04$/s or
$buff =~ /~\0\x04\0zmie~\0\0\x0a.{8}[\x10\x18]\x08$/s)
{
$type = 'MIE';
}
last;
}
$raf->Seek($pos, 0);
return $type ? { RAF => $raf, DirName => $type } : undef;
}
sub ProcessJPEG($$)
{
local $_;
my ($self, $dirInfo) = @_;
my ($ch, $s, $length);
my $verbose = $self->{OPTIONS}->{Verbose};
my $out = $self->{OPTIONS}->{TextOut};
my $raf = $$dirInfo{RAF};
my $htmlDump = $self->{HTML_DUMP};
my %dumpParms = ( Out => $out );
my ($success, $icc_profile, $wantPreview, $trailInfo, %extendedXMP);
return 0 unless $raf->Read($s, 2) == 2 and $s eq "\xff\xd8";
$dumpParms{MaxLen} = 128 if $verbose < 4;
$self->SetFileType();
if ($htmlDump) {
my $pos = $raf->Tell() - 2;
$self->HtmlDump(0, $pos, '[unknown header]') if $pos;
$self->HtmlDump($pos, 2, 'JPEG header', 'SOI Marker');
}
my $oldsep = $/;
$/ = "\xff";
my ($nextMarker, $nextSegDataPt, $nextSegPos, $combinedSegData, $dumpEnd);
Marker: for (;;) {
my $marker = $nextMarker;
my $segDataPt = $nextSegDataPt;
my $segPos = $nextSegPos;
undef $nextMarker;
undef $nextSegDataPt;
unless ($marker and ($marker==0xd9 or ($marker==0xda and not $wantPreview))) {
my $buff;
$raf->ReadLine($buff) or last;
for (;;) {
$raf->Read($ch, 1) or last Marker;
$nextMarker = ord($ch);
last unless $nextMarker == 0xff;
}
if ($nextMarker!=0xd9 and $nextMarker!=0x00 and $nextMarker!=0x01 and
($nextMarker<0xd0 or $nextMarker>0xd7))
{
last unless $raf->Read($s, 2) == 2;
my $len = unpack('n',$s);
last unless defined($len) and $len >= 2;
$nextSegPos = $raf->Tell();
$len -= 2;
last unless $raf->Read($buff, $len) == $len;
$nextSegDataPt = \$buff;
}
next unless defined $marker;
}
my $hdr = "\xff" . chr($marker);
my $markerName = JpegMarkerName($marker);
if (($marker & 0xf0) == 0xc0 and ($marker == 0xc0 or $marker & 0x03)) {
$length = length $$segDataPt;
if ($verbose) {
print $out "JPEG $markerName ($length bytes):\n";
HexDump($segDataPt, undef, %dumpParms, Addr=>$segPos) if $verbose>2;
}
next unless $length >= 6;
my ($p, $h, $w, $n) = unpack('Cn2C', $$segDataPt);
my $sof = GetTagTable('Image::ExifTool::JPEG::SOF');
$self->FoundTag($$sof{ImageWidth}, $w);
$self->FoundTag($$sof{ImageHeight}, $h);
$self->FoundTag($$sof{EncodingProcess}, $marker - 0xc0);
$self->FoundTag($$sof{BitsPerSample}, $p);
$self->FoundTag($$sof{ColorComponents}, $n);
next unless $n == 3 and $length >= 15;
my ($i, $hmin, $hmax, $vmin, $vmax);
for ($i=0; $i<$n; ++$i) {
my $sf = Get8u($segDataPt, 7 + 3 * $i);
my ($hf, $vf) = ($sf >> 4, $sf & 0x0f);
unless ($i) {
$hmin = $hmax = $hf;
$vmin = $vmax = $vf;
next;
}
$hmin = $hf if $hf < $hmin;
$hmax = $hf if $hf > $hmax;
$vmin = $vf if $vf < $vmin;
$vmax = $vf if $vf > $vmax;
}
if ($hmin and $vmin) {
my ($hs, $vs) = ($hmax / $hmin, $vmax / $vmin);
$self->FoundTag($$sof{YCbCrSubSampling}, "$hs $vs");
}
next;
} elsif ($marker == 0xd9) {
$verbose and print $out "JPEG EOI\n";
my $pos = $raf->Tell();
if ($htmlDump and $dumpEnd) {
$self->HtmlDump($dumpEnd, $pos-2-$dumpEnd, '[JPEG Image Data]', undef, 0x08);
$self->HtmlDump($pos-2, 2, 'JPEG EOI', undef);
$dumpEnd = 0;
}
$success = 1;
if ($wantPreview and $self->{VALUE}->{PreviewImageStart}) {
my $buff;
if ($raf->Read($buff, 1024) and ($buff =~ /\xff\xd8\xff./g or
($self->{Make} =~ /Minolta/i and $buff =~ /.\xd8\xff\xdb/g)))
{
my $start = $self->{VALUE}->{PreviewImageStart};
my $actual = $pos + pos($buff) - 4;
if ($start ne $actual and $verbose > 1) {
print $out "(Fixed PreviewImage location: $start -> $actual)\n";
}
$self->{VALUE}->{PreviewImageStart} = $actual;
}
$raf->Seek($pos, 0);
}
my $fromEnd = 0;
if ($trailInfo) {
$$trailInfo{ScanForAFCP} = 1;
$self->ProcessTrailers($trailInfo);
$fromEnd = $$trailInfo{Offset};
undef $trailInfo;
}
if ($verbose or $htmlDump) {
$raf->Seek(0, 2);
my $endPos = $raf->Tell() - $fromEnd;
$self->DumpUnknownTrailer({
RAF => $raf,
DataPos => $pos,
DirLen => $endPos - $pos
}) if $endPos > $pos;
}
last;
} elsif ($marker == 0xda) {
$verbose and print $out "JPEG SOS\n";
unless ($self->Options('FastScan')) {
$trailInfo = IdentifyTrailer($raf);
if ($trailInfo and $verbose < 3 and not $htmlDump) {
$self->ProcessTrailers($trailInfo) and undef $trailInfo;
}
if ($wantPreview) {
my $buff;
my $curPos = $raf->Tell();
if ($raf->Seek($self->GetValue('PreviewImageStart'), 0) and
$raf->Read($buff, 4) == 4 and
$buff =~ /^.\xd8\xff[\xc4\xdb\xe0-\xef]/)
{
undef $wantPreview;
}
$raf->Seek($curPos, 0) or last;
}
next if $trailInfo or $wantPreview or $verbose > 2 or $htmlDump;
}
$success = 1;
last;
} elsif ($marker==0x00 or $marker==0x01 or ($marker>=0xd0 and $marker<=0xd7)) {
$verbose and $marker and print $out "JPEG $markerName:\n";
next;
}
my $dumpType = '';
$length = length $$segDataPt;
if ($verbose) {
print $out "JPEG $markerName ($length bytes):\n";
if ($verbose > 2) {
my %extraParms = ( Addr => $segPos );
$extraParms{MaxLen} = 128 if $verbose == 4;
HexDump($segDataPt, undef, %dumpParms, %extraParms);
}
}
if ($marker == 0xe0) {
if ($$segDataPt =~ /^JFIF\0/) {
$dumpType = 'JFIF';
my %dirInfo = (
DataPt => $segDataPt,
DataPos => $segPos,
DirStart => 5,
DirLen => $length - 5,
);
SetByteOrder('MM');
my $tagTablePtr = GetTagTable('Image::ExifTool::JFIF::Main');
$self->ProcessDirectory(\%dirInfo, $tagTablePtr);
} elsif ($$segDataPt =~ /^JFXX\0\x10/) {
$dumpType = 'JFXX';
my $tagTablePtr = GetTagTable('Image::ExifTool::JFIF::Extension');
my $tagInfo = $self->GetTagInfo($tagTablePtr, 0x10);
$self->FoundTag($tagInfo, substr($$segDataPt, 6));
} elsif ($$segDataPt =~ /^(II|MM).{4}HEAPJPGM/s) {
$dumpType = 'CIFF';
my %dirInfo = (
RAF => new File::RandomAccess($segDataPt),
);
$self->{SET_GROUP1} = 'CIFF';
Image::ExifTool::CanonRaw::ProcessCRW($self, \%dirInfo);
delete $self->{SET_GROUP1};
}
} elsif ($marker == 0xe1) {
if ($$segDataPt =~ /^Exif\0/) {
undef $dumpType;
my $hdrLen = length($exifAPP1hdr);
my %dirInfo = (
Parent => $markerName,
DataPt => $segDataPt,
DataPos => $segPos,
DirStart => $hdrLen,
Base => $segPos + $hdrLen,
);
if ($htmlDump) {
$self->HtmlDump($segPos-4, 4, 'APP1 header',
"Data size: $length bytes");
$self->HtmlDump($segPos, $hdrLen, 'Exif header',
'APP1 data type: Exif');
$dumpEnd = $segPos + $length;
}
$self->ProcessTIFF(\%dirInfo);
my $start = $self->GetValue('PreviewImageStart');
my $length = $self->GetValue('PreviewImageLength');
if ($start and $length and
$start + $length > $self->{EXIF_POS} + length($self->{EXIF_DATA}) and
$self->{REQ_TAG_LOOKUP}->{previewimage})
{
$wantPreview = 1;
}
} elsif ($$segDataPt =~ /^$xmpExtAPP1hdr/) {
$dumpType = 'Extended XMP';
if (length $$segDataPt > 75) {
my ($size, $off) = unpack('x67N2', $$segDataPt);
my $guid = substr($$segDataPt, 35, 32);
my $extXMP = $extendedXMP{$guid};
$extXMP or $extXMP = $extendedXMP{$guid} = { };
$$extXMP{Size} = $size;
$$extXMP{$off} = substr($$segDataPt, 75);
my @offsets;
for ($off=0; $off<$size; ) {
last unless defined $$extXMP{$off};
push @offsets, $off;
$off += length $$extXMP{$off};
}
if ($off == $size) {
my $buff = '';
$buff .= $$extXMP{$_} foreach @offsets;
$dumpType = 'Extended XMP';
my $tagTablePtr = GetTagTable('Image::ExifTool::XMP::Main');
my %dirInfo = (
DataPt => \$buff,
Parent => $markerName,
);
$self->ProcessDirectory(\%dirInfo, $tagTablePtr);
delete $extendedXMP{$guid};
}
} else {
$self->Warn('Invalid extended XMP segment');
}
} else {
my $processed;
if ($$segDataPt =~ /^http/ or $$segDataPt =~ /<exif:/) {
$dumpType = 'XMP';
my $start = ($$segDataPt =~ /^$xmpAPP1hdr/) ? length($xmpAPP1hdr) : 0;
my $tagTablePtr = GetTagTable('Image::ExifTool::XMP::Main');
my %dirInfo = (
Base => 0,
DataPt => $segDataPt,
DataPos => $segPos,
DataLen => $length,
DirStart => $start,
DirLen => $length - $start,
Parent => $markerName,
);
$processed = $self->ProcessDirectory(\%dirInfo, $tagTablePtr);
}
if ($verbose and not $processed) {
$self->Warn("Ignored EXIF block length $length (bad header)");
}
}
} elsif ($marker == 0xe2) {
if ($$segDataPt =~ /^ICC_PROFILE\0/) {
$dumpType = 'ICC_Profile';
my $block_num = Get8u($segDataPt, 12);
my $blocks_tot = Get8u($segDataPt, 13);
$icc_profile = '' if $block_num == 1;
if (defined $icc_profile) {
$icc_profile .= substr($$segDataPt, 14);
if ($block_num == $blocks_tot) {
my $tagTablePtr = GetTagTable('Image::ExifTool::ICC_Profile::Main');
my %dirInfo = (
DataPt => \$icc_profile,
DataPos => $segPos + 14,
DataLen => length($icc_profile),
DirStart => 0,
DirLen => length($icc_profile),
Parent => $markerName,
);
$self->ProcessDirectory(\%dirInfo, $tagTablePtr);
undef $icc_profile;
}
}
} elsif ($$segDataPt =~ /^FPXR\0/) {
$dumpType = 'FPXR';
my $tagTablePtr = GetTagTable('Image::ExifTool::FlashPix::Main');
my %dirInfo = (
DataPt => $segDataPt,
DataPos => $segPos,
DataLen => $length,
DirStart => 0,
DirLen => $length,
Parent => $markerName,
LastFPXR => not ($nextMarker==$marker and $$nextSegDataPt=~/^FPXR\0/),
);
$self->ProcessDirectory(\%dirInfo, $tagTablePtr);
}
} elsif ($marker == 0xe3) {
if ($$segDataPt =~ /^(Meta|META|Exif)\0\0/) {
undef $dumpType;
my %dirInfo = (
Parent => $markerName,
DataPt => $segDataPt,
DataPos => $segPos,
DirStart => 6,
Base => $segPos + 6,
);
if ($htmlDump) {
$self->HtmlDump($segPos-4, 10, 'APP3 Meta header');
$dumpEnd = $segPos + $length;
}
my $tagTablePtr = GetTagTable('Image::ExifTool::Kodak::Meta');
$self->ProcessTIFF(\%dirInfo, $tagTablePtr);
}
} elsif ($marker == 0xe5) {
if ($$segDataPt =~ /^RMETA\0/) {
$dumpType = 'Ricoh RMETA';
my %dirInfo = (
Parent => $markerName,
DataPt => $segDataPt,
DataPos => $segPos,
DirStart => 6,
Base => $segPos + 6,
);
my $tagTablePtr = GetTagTable('Image::ExifTool::Ricoh::RMETA');
$self->ProcessDirectory(\%dirInfo, $tagTablePtr);
}
} elsif ($marker == 0xe6) {
if ($$segDataPt =~ /^EPPIM\0/) {
undef $dumpType;
my %dirInfo = (
Parent => $markerName,
DataPt => $segDataPt,
DataPos => $segPos,
DirStart => 6,
Base => $segPos + 6,
);
if ($htmlDump) {
$self->HtmlDump($segPos-4, 10, 'APP6 EPPIM header');
$dumpEnd = $segPos + $length;
}
my $tagTablePtr = GetTagTable('Image::ExifTool::JPEG::EPPIM');
$self->ProcessTIFF(\%dirInfo, $tagTablePtr);
}
} elsif ($marker == 0xe8) {
if ($$segDataPt =~ /^SPIFF\0/ and $length == 32) {
$dumpType = 'SPIFF';
my %dirInfo = (
DataPt => $segDataPt,
DataPos => $segPos,
DirStart => 6,
DirLen => $length - 6,
);
my $tagTablePtr = GetTagTable('Image::ExifTool::JPEG::SPIFF');
$self->ProcessDirectory(\%dirInfo, $tagTablePtr);
}
} elsif ($marker == 0xea) {
if ($$segDataPt =~ /^UNICODE\0/) {
$dumpType = 'PhotoStudio';
my $comment = $self->Unicode2Charset(substr($$segDataPt,8), 'MM');
$self->FoundTag('Comment', $comment);
}
} elsif ($marker == 0xec) {
if ($$segDataPt =~ /^Ducky/) {
$dumpType = 'Ducky';
my %dirInfo = (
DataPt => $segDataPt,
DataPos => $segPos,
DirStart => 5,
DirLen => $length - 5,
);
my $tagTablePtr = GetTagTable('Image::ExifTool::APP12::Ducky');
$self->ProcessDirectory(\%dirInfo, $tagTablePtr);
} else {
my %dirInfo = ( DataPt => $segDataPt );
my $tagTablePtr = GetTagTable('Image::ExifTool::APP12::PictureInfo');
$self->ProcessDirectory(\%dirInfo, $tagTablePtr) and $dumpType = 'Picture Info';
}
} elsif ($marker == 0xed) {
my $isOld;
if ($$segDataPt =~ /^$psAPP13hdr/ or ($$segDataPt =~ /^$psAPP13old/ and $isOld=1)) {
$dumpType = 'Photoshop';
my $dataPt = $segDataPt;
if (defined $combinedSegData) {
$combinedSegData .= substr($$segDataPt,length($psAPP13hdr));
$dataPt = \$combinedSegData;
}
if ($nextMarker == $marker and $$nextSegDataPt =~ /^$psAPP13hdr/) {
$combinedSegData = $$segDataPt unless defined $combinedSegData;
} else {
my $hdrlen = $isOld ? 27 : 14;
my $tagTablePtr = GetTagTable('Image::ExifTool::Photoshop::Main');
my %dirInfo = (
DataPt => $dataPt,
DataPos => $segPos,
DataLen => length $$dataPt,
DirStart => $hdrlen,
DirLen => length($$dataPt) - $hdrlen,
Parent => $markerName,
);
$self->ProcessDirectory(\%dirInfo, $tagTablePtr);
undef $combinedSegData;
}
} elsif ($$segDataPt =~ /^Adobe_CM/) {
$dumpType = 'Adobe_CM';
SetByteOrder('MM');
my $tagTablePtr = GetTagTable('Image::ExifTool::JPEG::AdobeCM');
my %dirInfo = (
DataPt => $segDataPt,
DataPos => $segPos,
DirStart => 8,
DirLen => $length - 8,
);
$self->ProcessDirectory(\%dirInfo, $tagTablePtr);
}
} elsif ($marker == 0xee) {
if ($$segDataPt =~ /^Adobe/) {
$dumpType = 'Adobe';
SetByteOrder('MM');
my $tagTablePtr = GetTagTable('Image::ExifTool::JPEG::Adobe');
my %dirInfo = (
DataPt => $segDataPt,
DataPos => $segPos,
DirStart => 5,
DirLen => $length - 5,
);
$self->ProcessDirectory(\%dirInfo, $tagTablePtr);
}
} elsif ($marker == 0xef) {
if ($$segDataPt =~ /^Q\s*(\d+)/ and $length == 4) {
$dumpType = 'GraphicConverter';
my $tagTablePtr = GetTagTable('Image::ExifTool::JPEG::GraphConv');
$self->HandleTag($tagTablePtr, 'Q', $1);
}
} elsif ($marker == 0xfe) {
$dumpType = 'Comment';
$self->FoundTag('Comment', $$segDataPt);
} elsif (($marker & 0xf0) != 0xe0) {
undef $dumpType;
}
if (defined $dumpType) {
if (not $dumpType and $self->{OPTIONS}->{Unknown}) {
$self->Warn("Unknown $markerName segment", 1);
}
if ($htmlDump) {
my $desc = $markerName . ($dumpType ? " $dumpType" : '') . ' segment';
$self->HtmlDump($segPos-4, $length+4, $desc, undef, 0x08);
$dumpEnd = $segPos + $length;
}
}
undef $$segDataPt;
}
$self->Warn('Invalid extended XMP') if %extendedXMP;
$/ = $oldsep;
$success or $self->Warn('JPEG format error');
return 1;
}
sub ProcessTIFF($$;$)
{
my ($self, $dirInfo, $tagTablePtr) = @_;
my $dataPt = $$dirInfo{DataPt};
my $fileType = $$dirInfo{Parent} || '';
my $raf = $$dirInfo{RAF};
my $base = $$dirInfo{Base} || 0;
my $outfile = $$dirInfo{OutFile};
my ($length, $err, $canonSig);
if ($raf) {
if ($outfile) {
$raf->Seek(0, 0) or return 0;
if ($base) {
$raf->Read($$dataPt, $base) == $base or return 0;
Write($outfile, $$dataPt) or $err = 1;
}
} else {
$raf->Seek($base, 0) or return 0;
}
$raf->Read($self->{EXIF_DATA}, 8) == 8 or return 0;
} elsif ($dataPt) {
my $dirStart = $$dirInfo{DirStart} || 0;
$self->{EXIF_DATA} = substr(${$$dirInfo{DataPt}}, $dirStart);
} elsif ($outfile) {
if ($self->SetPreferredByteOrder() eq 'MM') {
$self->{EXIF_DATA} = "MM\0\x2a\0\0\0\x08";
} else {
$self->{EXIF_DATA} = "II\x2a\0\x08\0\0\0";
}
} else {
$self->{EXIF_DATA} = '';
}
$$self{FIRST_EXIF_POS} = $base + $$self{BASE} unless defined $$self{FIRST_EXIF_POS};
$$self{EXIF_POS} = $base;
$dataPt = \$self->{EXIF_DATA};
my $byteOrder = substr($$dataPt,0,2);
SetByteOrder($byteOrder) or return 0;
$self->{EXIF_BYTE_ORDER} = $byteOrder;
my $identifier = Get16u($dataPt, 2);
my $offset = Get32u($dataPt, 4);
$offset >= 8 or return 0;
if ($raf) {
if ($identifier == 0x2a and $offset >= 16) {
$raf->Read($canonSig, 8) == 8 or return 0;
$$dataPt .= $canonSig;
if ($canonSig =~ /^(CR\x02\0|\xba\xb0\xac\xbb)/) {
$fileType = $canonSig =~ /^CR/ ? 'CR2' : 'Canon 1D RAW';
$self->HtmlDump($base+8, 8, "[$fileType header]") if $self->{HTML_DUMP};
} else {
undef $canonSig;
}
} elsif ($identifier == 0x55 and $fileType =~ /^(RAW|TIFF)$/) {
$fileType = 'RAW';
$tagTablePtr = GetTagTable('Image::ExifTool::Panasonic::Raw');
} elsif ($identifier == 0x2b and $fileType eq 'TIFF') {
$raf->Seek(0);
return 1 if Image::ExifTool::BigTIFF::ProcessBTF($self, $dirInfo);
} elsif (Get8u($dataPt, 2) == 0xbc and $byteOrder eq 'II' and $fileType eq 'TIFF') {
$fileType = 'HDP';
my $ver = Get8u($dataPt, 3);
if ($ver > 1) {
$self->Error("Windows HD Photo version $ver files not yet supported");
return 1;
}
}
if ($fileType and not $self->{VALUE}->{FileType}) {
my $lookup = $fileTypeLookup{$fileType};
my $t = (($lookup and $$lookup[0] eq 'TIFF') or $fileType =~ /RAW/) ? $fileType : undef;
$self->SetFileType($t);
}
}
$self->FoundTag('ExifByteOrder', GetByteOrder());
if ($self->{HTML_DUMP}) {
my $tip = sprintf('Byte order: %s endian\\nIdentifier: 0x%.4x\\nIFD0 offset: 0x%.4x',
(GetByteOrder() eq 'II') ? 'Little' : 'Big', $identifier, $offset);
$self->HtmlDump($base, 8, "TIFF header", $tip, 0);
}
$self->{TIFF_TYPE} = $fileType;
$tagTablePtr or $tagTablePtr = GetTagTable('Image::ExifTool::Exif::Main');
my %dirInfo = (
Base => $base,
DataPt => $dataPt,
DataLen => length $$dataPt,
DataPos => 0,
DirStart => $offset,
DirLen => length($$dataPt) - $offset,
RAF => $raf,
DirName => 'IFD0',
Parent => $fileType,
ImageData=> 1,
);
unless ($outfile) {
$self->ProcessDirectory(\%dirInfo, $tagTablePtr);
if ($self->{VALUE}->{GeoTiffDirectory}) {
Image::ExifTool::GeoTiff::ProcessGeoTiff($self);
}
if ($raf) {
my $trailInfo = IdentifyTrailer($raf);
if ($trailInfo) {
$$trailInfo{ScanForAFCP} = 1;
$self->ProcessTrailers($trailInfo);
}
}
if ($$self{DNGVersion}) {
unless ($self->{VALUE}->{FileType} eq 'DNG') {
$self->{VALUE}->{FileType} = 'DNG';
$self->{VALUE}->{MIMEType} = $mimeType{DNG};
}
}
return 1;
}
if ($$dirInfo{NoTiffEnd}) {
delete $self->{TIFF_END};
} else {
$self->{TIFF_END} = 0;
}
if ($canonSig) {
$dirInfo{OutFile} = $outfile;
Image::ExifTool::CanonRaw::WriteCR2($self, \%dirInfo, $tagTablePtr) or $err = 1;
} else {
$dirInfo{NewDataPos} = 8;
$dirInfo{PreserveImagePadding} = 1 if $fileType eq 'ORF' or $identifier != 0x2a;
my $newData = $self->WriteDirectory(\%dirInfo, $tagTablePtr);
if (not defined $newData) {
$err = 1;
} elsif (length($newData)) {
my $offset = 8;
my $header = substr($$dataPt, 0, 4) . Set32u($offset);
Write($outfile, $header, $newData) or $err = 1;
undef $newData;
}
if (ref $dirInfo{ImageData} and not $err) {
$self->CopyImageData($dirInfo{ImageData}, $outfile) or $err = 1;
delete $dirInfo{ImageData};
}
}
if ($raf and $self->{TIFF_END} and not $err) {
my ($buf, $trailInfo);
$raf->Seek(0, 2) or $err = 1;
my $extra = $raf->Tell() - $self->{TIFF_END};
for (;;) {
last unless $extra > 12;
$raf->Seek($self->{TIFF_END});
$trailInfo = IdentifyTrailer($raf);
last unless $trailInfo;
my $tbuf = '';
$$trailInfo{OutFile} = \$tbuf;
$$trailInfo{ScanForAFCP} = 1;
unless ($self->ProcessTrailers($trailInfo)) {
undef $trailInfo;
$err = 1;
last;
}
$extra = $$trailInfo{DataPos} - $self->{TIFF_END};
last;
}
if ($extra > 0 and $self->{TIFF_END} & 0x01) {
$raf->Seek($self->{TIFF_END}, 0) or $err = 1;
$raf->Read($buf, 1) or $err = 1;
$buf eq "\0" and --$extra, ++$self->{TIFF_END};
}
if ($extra > 0) {
if ($self->{DEL_GROUP}->{Trailer}) {
$self->VPrint(0, " Deleting unknown trailer ($extra bytes)\n");
++$self->{CHANGED};
} else {
$self->VPrint(0, " Preserving unknown trailer ($extra bytes)\n");
$raf->Seek($self->{TIFF_END}, 0) or $err = 1;
while ($extra) {
my $n = $extra < 65536 ? $extra : 65536;
$raf->Read($buf, $n) == $n or $err = 1, last;
Write($outfile, $buf) or $err = 1, last;
$extra -= $n;
}
}
}
$self->WriteTrailerBuffer($trailInfo, $outfile) or $err = 1 if $trailInfo;
my $trailPt = $self->AddNewTrailers();
Write($outfile, $$trailPt) or $err = 1 if $trailPt;
}
if ($$self{DNGVersion} and $$self{DNGVersion} ge "\x01\x03\0\0") {
my $ver = join('.', unpack('C*', $$self{DNGVersion}));;
$self->Error("DNG Version $ver not yet supported", 1);
}
delete $self->{TIFF_END};
return $err ? -1 : 1;
}
sub TagTableKeys($)
{
local $_;
my $tagTablePtr = shift;
my @keyList;
foreach (keys %$tagTablePtr) {
push(@keyList, $_) unless $specialTags{$_};
}
return @keyList;
}
sub GetTagTable($)
{
my $tableName = shift or return undef;
my $table = $allTables{$tableName};
unless ($table) {
no strict 'refs';
unless (defined %$tableName) {
if ($tableName =~ /(.*)::/) {
my $module = $1;
if (eval "require $module") {
if (not defined %$tableName and $module eq 'Image::ExifTool::XMP') {
}
} else {
$@ and warn $@;
}
}
unless (defined %$tableName) {
warn "Can't find table $tableName\n";
return undef;
}
}
no strict 'refs';
$table = \%$tableName;
my $defaultGroups = $$table{GROUPS};
$defaultGroups or $defaultGroups = $$table{GROUPS} = { };
unless ($$defaultGroups{0} and $$defaultGroups{1}) {
if ($tableName =~ /Image::.*?::([^:]*)/) {
$$defaultGroups{0} = $1 unless $$defaultGroups{0};
$$defaultGroups{1} = $1 unless $$defaultGroups{1};
} else {
$$defaultGroups{0} = $tableName unless $$defaultGroups{0};
$$defaultGroups{1} = $tableName unless $$defaultGroups{1};
}
}
$$defaultGroups{2} = 'Other' unless $$defaultGroups{2};
unless ($$table{TAG_PREFIX}) {
my $tagPrefix;
if ($tableName =~ /Image::.*?::(.*)::Main/ || $tableName =~ /Image::.*?::(.*)/) {
($tagPrefix = $1) =~ s/::/_/g;
} else {
$tagPrefix = $tableName;
}
$$table{TAG_PREFIX} = $tagPrefix;
}
SetupTagTable($table);
if (defined %UserDefined and $UserDefined{$tableName}) {
my $tagID;
foreach $tagID (TagTableKeys($UserDefined{$tableName})) {
my $tagInfo = $UserDefined{$tableName}->{$tagID};
if (ref $tagInfo eq 'HASH') {
$$tagInfo{Name} or $$tagInfo{Name} = ucfirst($tagID);
} else {
$tagInfo = { Name => $tagInfo };
}
if ($$table{WRITABLE} and not defined $$tagInfo{Writable} and
not $$tagInfo{SubDirectory})
{
$$tagInfo{Writable} = $$table{WRITABLE};
}
delete $$table{$tagID};
AddTagToTable($table, $tagID, $tagInfo);
}
}
GenerateTagIDs($table) if $didTagID;
push @tableOrder, $tableName;
$allTables{$tableName} = $table;
}
return $table;
}
sub ProcessDirectory($$$;$)
{
my ($self, $dirInfo, $tagTablePtr, $processProc) = @_;
return 0 unless $tagTablePtr and $dirInfo;
$processProc or $processProc = $$tagTablePtr{PROCESS_PROC};
$$dirInfo{DirName} or $$dirInfo{DirName} = $tagTablePtr->{GROUPS}->{0};
if (defined $$dirInfo{DirStart} and defined $$dirInfo{DataPos}) {
my $addr = $$dirInfo{DirStart} + $$dirInfo{DataPos} + ($$dirInfo{Base}||0);
if ($self->{PROCESSED}->{$addr}) {
$self->Warn("$$dirInfo{DirName} pointer references previous $self->{PROCESSED}->{$addr} directory");
return 0;
}
$self->{PROCESSED}->{$addr} = $$dirInfo{DirName};
}
$processProc or $processProc = \&Image::ExifTool::Exif::ProcessExif;
my $oldOrder = GetByteOrder();
my $oldIndent = $self->{INDENT};
my $oldDir = $self->{DIR_NAME};
$self->{LIST_TAGS} = { };
$self->{INDENT} .= '| ';
$self->{DIR_NAME} = $$dirInfo{DirName};
my $rtnVal = &$processProc($self, $dirInfo, $tagTablePtr);
$self->{INDENT} = $oldIndent;
$self->{DIR_NAME} = $oldDir;
SetByteOrder($oldOrder);
return $rtnVal;
}
sub GetFileExtension($)
{
my $filename = shift;
my $fileExt;
if ($filename and $filename =~ /.*\.(.+)$/) {
$fileExt = uc($1);
$fileExt eq 'TIF' and $fileExt = 'TIFF';
}
return $fileExt;
}
sub GetTagInfoList($$)
{
my ($tagTablePtr, $tagID) = @_;
my $tagInfo = $$tagTablePtr{$tagID};
if (ref $tagInfo eq 'HASH') {
return ($tagInfo);
} elsif (ref $tagInfo eq 'ARRAY') {
return @$tagInfo;
} elsif ($tagInfo) {
$tagInfo = $$tagTablePtr{$tagID} = { Name => $tagInfo };
return ($tagInfo);
}
return ();
}
sub GetTagInfo($$$;$$$)
{
my ($self, $tagTablePtr, $tagID) = @_;
my ($valPt, $format, $count);
my @infoArray = GetTagInfoList($tagTablePtr, $tagID);
my $tagInfo;
foreach $tagInfo (@infoArray) {
my $condition = $$tagInfo{Condition};
if ($condition) {
($valPt, $format, $count) = splice(@_, 3) if @_ > 3;
return '' if $condition =~ /\$(valPt|format|count)\b/ and not defined $valPt;
my $oldVal = $self->{VALUE}->{$$tagInfo{Name}};
local $SIG{'__WARN__'} = \&SetWarning;
undef $evalWarning;
unless (eval $condition) {
$@ and $evalWarning = $@;
$self->Warn("Condition $$tagInfo{Name}: " . CleanWarning()) if $evalWarning;
next;
}
}
if ($$tagInfo{Unknown} and not $self->{OPTIONS}->{Unknown}) {
return undef;
}
return $tagInfo;
}
if (not $tagInfo and $self->{OPTIONS}->{Unknown} and $tagID =~ /^\d+$/ and
not $$self{NO_UNKNOWN})
{
my $printConv;
if (defined $$tagTablePtr{PRINT_CONV}) {
$printConv = $$tagTablePtr{PRINT_CONV};
} else {
$printConv = 'length($val) > 60 ? substr($val,0,55) . "[...]" : $val';
}
my $hex = sprintf("0x%.4x", $tagID);
my $prefix = $$tagTablePtr{TAG_PREFIX};
$tagInfo = {
Name => "${prefix}_$hex",
Description => MakeDescription($prefix, $hex),
Unknown => 1,
Writable => 0,
PrintConv => $printConv,
};
AddTagToTable($tagTablePtr, $tagID, $tagInfo);
} else {
undef $tagInfo;
}
return $tagInfo;
}
sub AddTagToTable($$$)
{
my ($tagTablePtr, $tagID, $tagInfo) = @_;
if ($$tagInfo{Groups}) {
foreach (keys %{$$tagTablePtr{GROUPS}}) {
next if $tagInfo->{Groups}->{$_};
$tagInfo->{Groups}->{$_} = $tagTablePtr->{GROUPS}->{$_};
}
} else {
$$tagInfo{Groups} = $$tagTablePtr{GROUPS};
}
$$tagInfo{Flags} and ExpandFlags($tagInfo);
$$tagInfo{GotGroups} = 1,
$$tagInfo{Table} = $tagTablePtr;
$$tagInfo{TagID} = $tagID;
unless ($$tagInfo{Name}) {
my $prefix = $$tagTablePtr{TAG_PREFIX};
$$tagInfo{Name} = "${prefix}_$tagID";
$$tagInfo{Description} = MakeDescription($prefix, $tagID);
}
$$tagTablePtr{$tagID} = $tagInfo unless defined $$tagTablePtr{$tagID};
}
sub HandleTag($$$$;%)
{
my ($self, $tagTablePtr, $tag, $val, %parms) = @_;
my $verbose = $self->{OPTIONS}->{Verbose};
my $tagInfo = $parms{TagInfo} || $self->GetTagInfo($tagTablePtr, $tag, \$val);
my $dataPt = $parms{DataPt};
my $subdir;
if ($tagInfo) {
$subdir = $$tagInfo{SubDirectory}
} else {
return undef unless $verbose;
}
unless (defined $val or $subdir) {
my $start = $parms{Start} || 0;
my $size = $parms{Size} || 0;
if ($dataPt and $start >= 0 and $start + $size <= length($$dataPt)) {
$val = substr($$dataPt, $start, $size);
} else {
my $name = $tagInfo ? $$tagInfo{Name} : "tag $tag";
$self->Warn("Error extracting value for $name");
return undef;
}
}
if ($verbose) {
$parms{Value} = $val;
$parms{Table} = $tagTablePtr;
$self->VerboseInfo($tag, $tagInfo, %parms);
}
if ($tagInfo) {
if ($subdir) {
my $subdirStart = $parms{Start};
if ($$subdir{Start}) {
my $valuePtr = 0;
$subdirStart += eval $$subdir{Start};
}
$dataPt or $dataPt = \$val;
my %dirInfo = (
DirName => $$subdir{DirName} || $$tagInfo{Name},
DataPt => $dataPt,
DataLen => length $$dataPt,
DataPos => $parms{DataPos},
DirStart => $subdirStart,
DirLen => $parms{Size},
Parent => $parms{Parent},
Base => $parms{Base},
Multi => $$subdir{Multi},
);
my $oldOrder = GetByteOrder();
SetByteOrder($$subdir{ByteOrder}) if $$subdir{ByteOrder};
my $subTablePtr = GetTagTable($$subdir{TagTable}) || $tagTablePtr;
$self->ProcessDirectory(\%dirInfo, $subTablePtr, $$subdir{ProcessProc});
SetByteOrder($oldOrder);
} else {
return $self->FoundTag($tagInfo, $val);
}
}
return undef;
}
sub FoundTag($$$)
{
local $_;
my ($self, $tagInfo, $value) = @_;
my $tag;
if (ref $tagInfo eq 'HASH') {
$tag = $$tagInfo{Name} or warn("No tag name\n"), return undef;
} else {
$tag = $tagInfo;
$tagInfo = $self->GetTagInfo(GetTagTable('Image::ExifTool::Extra'), $tag);
$tagInfo or $tagInfo = { Name => $tag, Groups => \%allGroupsExifTool };
$self->{OPTIONS}->{Verbose} and $self->VerboseInfo(undef, $tagInfo, Value => $value);
}
my $rawValueHash = $self->{VALUE};
if ($$tagInfo{RawConv}) {
my @val;
if (ref $value eq 'HASH') {
foreach (keys %$value) { $val[$_] = $$rawValueHash{$$value{$_}}; }
}
my $conv = $$tagInfo{RawConv};
local $SIG{'__WARN__'} = \&SetWarning;
undef $evalWarning;
if (ref $conv eq 'CODE') {
$value = &$conv($value, $self);
} else {
my $val = $value;
$value = eval $conv;
$@ and $evalWarning = $@;
}
$self->Warn("RawConv $tag: " . CleanWarning()) if $evalWarning;
return undef unless defined $value;
}
my $priority = $$tagInfo{Priority};
defined $priority or $priority = $tagInfo->{Table}->{PRIORITY};
if (defined $$rawValueHash{$tag}) {
if ($self->{LIST_TAGS}->{$tagInfo}) {
$tag = $self->{LIST_TAGS}->{$tagInfo};
if (ref $$rawValueHash{$tag} ne 'ARRAY') {
$$rawValueHash{$tag} = [ $$rawValueHash{$tag} ];
}
push @{$$rawValueHash{$tag}}, $value;
return $tag;
}
my $nextTag = NextTagKey($rawValueHash, $tag);
my $oldPriority = $self->{PRIORITY}->{$tag} || 1;
$priority = 1 if not defined $priority or
($priority == 0 and $self->{DIR_NAME} and $self->{PRIORITY_DIR} and
$self->{DIR_NAME} eq $self->{PRIORITY_DIR});
if ($priority >= $oldPriority) {
$self->{MOVED_KEY} = $nextTag;
$self->{PRIORITY}->{$nextTag} = $self->{PRIORITY}->{$tag};
$$rawValueHash{$nextTag} = $$rawValueHash{$tag};
$self->{FILE_ORDER}->{$nextTag} = $self->{FILE_ORDER}->{$tag};
my $oldInfo = $self->{TAG_INFO}->{$nextTag} = $self->{TAG_INFO}->{$tag};
if ($self->{GROUP1}->{$tag}) {
$self->{GROUP1}->{$nextTag} = $self->{GROUP1}->{$tag};
delete $self->{GROUP1}->{$tag};
}
$self->{LIST_TAGS}->{$oldInfo} = $nextTag if $self->{LIST_TAGS}->{$oldInfo};
} else {
$tag = $nextTag;
}
$self->{PRIORITY}->{$tag} = $priority;
} elsif ($priority) {
$self->{PRIORITY}->{$tag} = $priority;
}
$$rawValueHash{$tag} = $value;
$self->{FILE_ORDER}->{$tag} = ++$self->{NUM_FOUND};
$self->{TAG_INFO}->{$tag} = $tagInfo;
$self->{GROUP1}->{$tag} = $self->{SET_GROUP1} if $self->{SET_GROUP1};
$self->{LIST_TAGS}->{$tagInfo} = $tag if $$tagInfo{List} and not $$self{NO_LIST};
return $tag;
}
sub NextTagKey($$)
{
my ($info, $tag) = @_;
if (exists $$info{$tag}) {
my $name = $tag;
my $i;
for ($i=1; ; ++$i) {
$tag = "$name ($i)";
last unless exists $$info{$tag};
}
}
return $tag;
}
sub SetPriorityDir($)
{
my $self = shift;
$self->{PRIORITY_DIR} = $self->{DIR_NAME} unless $self->{PRIORITY_DIR};
}
sub SetGroup1($$$)
{
my ($self, $tagKey, $extra) = @_;
$self->{GROUP1}->{$tagKey} = $extra;
}
sub GenerateTagIDs($)
{
my $table = shift;
unless ($$table{DID_TAG_ID}) {
$$table{DID_TAG_ID} = 1;
my ($tagID, $tagInfo);
foreach $tagID (keys %$table) {
next if $specialTags{$tagID};
my @infoArray = GetTagInfoList($table,$tagID);
foreach $tagInfo (@infoArray) {
$$tagInfo{TagID} = $tagID;
}
}
}
}
sub GenerateAllTagIDs()
{
unless ($didTagID) {
my $tableName;
foreach $tableName (keys %allTables) {
GenerateTagIDs($allTables{$tableName});
}
$didTagID = 1;
}
}
sub DeleteTag($$)
{
my ($self, $tag) = @_;
delete $self->{VALUE}->{$tag};
delete $self->{FILE_ORDER}->{$tag};
delete $self->{TAG_INFO}->{$tag};
delete $self->{GROUP1}->{$tag};
}
sub SetFileType($;$)
{
my $self = shift;
my $baseType = $self->{FILE_TYPE};
my $fileType = shift || $baseType;
my $mimeType = $mimeType{$fileType};
$mimeType = $mimeType{$baseType} unless $mimeType or $baseType eq 'TIFF';
$self->FoundTag('FileType', $fileType);
$self->FoundTag('MIMEType', $mimeType || 'application/unknown');
}
sub ModifyMimeType($;$)
{
my ($self, $mime) = @_;
$mime =~ m{/} or $mime = $mimeType{$mime} or return;
my $old = $self->{VALUE}->{MIMEType};
if (defined $old) {
my ($a, $b) = split '/', $old;
my ($c, $d) = split '/', $mime;
$d =~ s/^x-//;
$self->{VALUE}->{MIMEType} = "$c/$b-$d";
$self->VPrint(0, " Modified MIMEType = $c/$b-$d\n");
} else {
$self->FoundTag('MIMEType', $mime);
}
}
sub VPrint($$@)
{
my $self = shift;
my $level = shift;
if ($self->{OPTIONS}->{Verbose} and $self->{OPTIONS}->{Verbose} > $level) {
my $out = $self->{OPTIONS}->{TextOut};
print $out @_;
}
}
sub VerboseDump($$;%)
{
my $self = shift;
my $dataPt = shift;
if ($self->{OPTIONS}->{Verbose} and $self->{OPTIONS}->{Verbose} > 2) {
HexDump($dataPt, undef,
Out => $self->{OPTIONS}->{TextOut},
MaxLen => $self->{OPTIONS}->{Verbose} < 4 ? 96 : undef,
@_
);
}
}
sub ExtractBinary($$$;$)
{
my ($self, $offset, $length, $tag) = @_;
if ($tag and $tag eq 'PreviewImage') {
$$self{PreviewImageStart} = $offset;
$$self{PreviewImageLength} = $length;
}
if ($tag and not $self->{OPTIONS}->{Binary} and not $self->{OPTIONS}->{Verbose} and
not $self->{REQ_TAG_LOOKUP}->{lc($tag)})
{
return "Binary data $length bytes";
}
my $buff;
unless ($self->{RAF}->Seek($offset,0)
and $self->{RAF}->Read($buff, $length) == $length)
{
$tag or $tag = 'binary data';
$self->Warn("Error reading $tag from file");
return undef;
}
return $buff;
}
sub ProcessBinaryData($$$)
{
my ($self, $dirInfo, $tagTablePtr) = @_;
my $dataPt = $$dirInfo{DataPt};
my $offset = $$dirInfo{DirStart} || 0;
my $size = $$dirInfo{DirLen} || (length($$dataPt) - $offset);
my $base = $$dirInfo{Base} || 0;
my $verbose = $self->{OPTIONS}->{Verbose};
my $unknown = $self->{OPTIONS}->{Unknown};
my $dataPos = $$dirInfo{DataPos} || 0;
my $defaultFormat = $$tagTablePtr{FORMAT} || 'int8u';
my $increment = $formatSize{$defaultFormat};
unless ($increment) {
warn "Unknown format $defaultFormat\n";
$defaultFormat = 'int8u';
$increment = $formatSize{$defaultFormat};
}
my @tags;
if ($unknown > 1 and defined $$tagTablePtr{FIRST_ENTRY}) {
@tags = ($$tagTablePtr{FIRST_ENTRY}..(int($size/$increment) - 1));
my @ftags = grep /\./, TagTableKeys($tagTablePtr);
@tags = sort { $a <=> $b } @tags, @ftags if @ftags;
} elsif ($$dirInfo{DataMember}) {
@tags = @{$$dirInfo{DataMember}};
$verbose = 0;
} else {
@tags = sort { $a <=> $b } TagTableKeys($tagTablePtr);
}
$self->VerboseDir('BinaryData', undef, $size) if $verbose;
$$self{NO_UNKNOWN} = 1 if $unknown < 2;
my $index;
my $nextIndex = 0;
my %val;
foreach $index (@tags) {
my $tagInfo;
if ($$tagTablePtr{$index}) {
$tagInfo = $self->GetTagInfo($tagTablePtr, $index) or next;
next if $$tagInfo{Unknown} and
($$tagInfo{Unknown} > $unknown or $index < $nextIndex);
} else {
next unless $unknown > 1;
next if $index < $nextIndex;
$tagInfo = $self->GetTagInfo($tagTablePtr, $index) or next;
$$tagInfo{Unknown} = 2;
}
my $entry = int($index) * $increment;
my $count = 1;
my $format = $$tagInfo{Format};
if ($format) {
if ($format =~ /(.*)\[(.*)\]/) {
$format = $1;
$count = $2;
$count = eval $count;
$@ and warn("Format $$tagInfo{Name}: $@"), next;
next if $count < 0;
} elsif ($format eq 'string') {
$count = ($size > $entry) ? $size - $entry : 0;
} elsif ($format eq 'pstring') {
$count = ($size > $entry) ? Get8u($dataPt, ($entry++)+$offset) : 0;
$format = 'string';
}
} else {
$format = $defaultFormat;
}
if ($unknown > 1) {
my $ni = int($index) + ($formatSize{$format} * $count) / $increment;
$nextIndex = $ni unless $nextIndex > $ni;
}
if ($$tagInfo{SubDirectory}) {
my $len = $size - $entry;
if ($$tagInfo{Format} and $formatSize{$format}) {
my $n = $count * $formatSize{$format};
$len = $n if $n < $len;
} else {
$len = $size - $entry;
}
my %subdirInfo = (
DataPt => $dataPt,
DirStart => $entry + $offset,
DirLen => $len,
Base => $base,
);
my $subTablePtr = GetTagTable($tagInfo->{SubDirectory}->{TagTable});
$self->ProcessDirectory(\%subdirInfo, $subTablePtr);
next;
}
my $val = ReadValue($dataPt, $entry+$offset, $format, $count, $size-$entry);
next unless defined $val;
$val &= $$tagInfo{Mask} if $$tagInfo{Mask};
if ($verbose) {
my $len = $count * ($formatSize{$format} || 1);
$len > $size - $entry and $len = $size - $entry;
$self->VerboseInfo($index, $tagInfo,
Table => $tagTablePtr,
Value => $val,
DataPt => $dataPt,
Size => $len,
Start => $entry+$offset,
Addr => $entry+$offset+$base+$dataPos,
Format => $format,
Count => $count,
);
}
$val += $base + $$self{BASE} if $$tagInfo{IsOffset};
$val{$index} = $val;
$self->FoundTag($tagInfo,$val);
}
delete $$self{NO_UNKNOWN};
return 1;
}
unless ($Image::ExifTool::noConfig) {
my $config = '.ExifTool_config';
my $home = $ENV{EXIFTOOL_HOME} || $ENV{HOME} ||
($ENV{HOMEDRIVE} || '') . ($ENV{HOMEPATH} || '') || '.';
my $file = "$home/$config";
-r $file or $file = ($0 =~ /(.*[\\\/])/ ? $1 : './') . $config;
if (-r $file) {
eval "require '$file'";
$@ and $_=$@, s/Compilation failed.*//s, warn $_;
if (@Image::ExifTool::UserDefined::Lenses) {
foreach (@Image::ExifTool::UserDefined::Lenses) {
$Image::ExifTool::userLens{$_} = 1;
}
}
}
}
1;