line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
2
|
|
|
|
|
|
|
# File: PLIST.pm |
3
|
|
|
|
|
|
|
# |
4
|
|
|
|
|
|
|
# Description: Read Apple PLIST information |
5
|
|
|
|
|
|
|
# |
6
|
|
|
|
|
|
|
# Revisions: 2013-02-01 - P. Harvey Created |
7
|
|
|
|
|
|
|
# |
8
|
|
|
|
|
|
|
# References: 1) http://www.apple.com/DTDs/PropertyList-1.0.dtd |
9
|
|
|
|
|
|
|
# 2) http://opensource.apple.com/source/CF/CF-550/CFBinaryPList.c |
10
|
|
|
|
|
|
|
# |
11
|
|
|
|
|
|
|
# Notes: - Sony MODD files also use XML PLIST format, but with a few quirks |
12
|
|
|
|
|
|
|
# |
13
|
|
|
|
|
|
|
# - Decodes both the binary and XML-based PLIST formats |
14
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
15
|
|
|
|
|
|
|
|
16
|
|
|
|
|
|
|
package Image::ExifTool::PLIST; |
17
|
|
|
|
|
|
|
|
18
|
8
|
|
|
8
|
|
4447
|
use strict; |
|
8
|
|
|
|
|
39
|
|
|
8
|
|
|
|
|
319
|
|
19
|
8
|
|
|
8
|
|
52
|
use vars qw($VERSION); |
|
8
|
|
|
|
|
24
|
|
|
8
|
|
|
|
|
398
|
|
20
|
8
|
|
|
8
|
|
53
|
use Image::ExifTool qw(:DataAccess :Utils); |
|
8
|
|
|
|
|
22
|
|
|
8
|
|
|
|
|
2135
|
|
21
|
8
|
|
|
8
|
|
3337
|
use Image::ExifTool::XMP; |
|
8
|
|
|
|
|
141
|
|
|
8
|
|
|
|
|
573
|
|
22
|
8
|
|
|
8
|
|
85
|
use Image::ExifTool::GPS; |
|
8
|
|
|
|
|
30
|
|
|
8
|
|
|
|
|
20612
|
|
23
|
|
|
|
|
|
|
|
24
|
|
|
|
|
|
|
$VERSION = '1.10'; |
25
|
|
|
|
|
|
|
|
26
|
|
|
|
|
|
|
sub ExtractObject($$;$); |
27
|
|
|
|
|
|
|
sub Get24u($$); |
28
|
|
|
|
|
|
|
|
29
|
|
|
|
|
|
|
# access routines to read various-sized integer/real values (add 0x100 to size for reals) |
30
|
|
|
|
|
|
|
my %readProc = ( |
31
|
|
|
|
|
|
|
1 => \&Get8u, |
32
|
|
|
|
|
|
|
2 => \&Get16u, |
33
|
|
|
|
|
|
|
3 => \&Get24u, |
34
|
|
|
|
|
|
|
4 => \&Get32u, |
35
|
|
|
|
|
|
|
8 => \&Get64u, |
36
|
|
|
|
|
|
|
0x104 => \&GetFloat, |
37
|
|
|
|
|
|
|
0x108 => \&GetDouble, |
38
|
|
|
|
|
|
|
); |
39
|
|
|
|
|
|
|
|
40
|
|
|
|
|
|
|
# recognize different types of PLIST files based on certain tags |
41
|
|
|
|
|
|
|
my %plistType = ( |
42
|
|
|
|
|
|
|
adjustmentBaseVersion => 'AAE', |
43
|
|
|
|
|
|
|
); |
44
|
|
|
|
|
|
|
|
45
|
|
|
|
|
|
|
# PLIST tags (generated on-the-fly for most tags) |
46
|
|
|
|
|
|
|
%Image::ExifTool::PLIST::Main = ( |
47
|
|
|
|
|
|
|
PROCESS_PROC => \&ProcessPLIST, |
48
|
|
|
|
|
|
|
GROUPS => { 0 => 'PLIST', 1 => 'XML', 2 => 'Document' }, |
49
|
|
|
|
|
|
|
VARS => { LONG_TAGS => 4 }, |
50
|
|
|
|
|
|
|
NOTES => q{ |
51
|
|
|
|
|
|
|
Apple Property List tags. ExifTool reads both XML and binary-format PLIST |
52
|
|
|
|
|
|
|
files, and will extract any existing tags even if they aren't listed below. |
53
|
|
|
|
|
|
|
These tags belong to the family 0 "PLIST" group, but family 1 group may be |
54
|
|
|
|
|
|
|
either "XML" or "PLIST" depending on whether the format is XML or binary. |
55
|
|
|
|
|
|
|
}, |
56
|
|
|
|
|
|
|
# |
57
|
|
|
|
|
|
|
# tags found in PLIST information of QuickTime iTunesInfo iTunMOVI atom (ref PH) |
58
|
|
|
|
|
|
|
# |
59
|
|
|
|
|
|
|
'cast//name' => { Name => 'Cast', List => 1 }, |
60
|
|
|
|
|
|
|
'directors//name' => { Name => 'Directors', List => 1 }, |
61
|
|
|
|
|
|
|
'producers//name' => { Name => 'Producers', List => 1 }, |
62
|
|
|
|
|
|
|
'screenwriters//name' => { Name => 'Screenwriters', List => 1 }, |
63
|
|
|
|
|
|
|
'codirectors//name' => { Name => 'Codirectors', List => 1 }, # (NC) |
64
|
|
|
|
|
|
|
'studio//name' => { Name => 'Studio', List => 1 }, # (NC) |
65
|
|
|
|
|
|
|
# |
66
|
|
|
|
|
|
|
# tags found in MODD files (ref PH) |
67
|
|
|
|
|
|
|
# |
68
|
|
|
|
|
|
|
'MetaDataList//DateTimeOriginal' => { |
69
|
|
|
|
|
|
|
Name => 'DateTimeOriginal', |
70
|
|
|
|
|
|
|
Description => 'Date/Time Original', |
71
|
|
|
|
|
|
|
Groups => { 2 => 'Time' }, |
72
|
|
|
|
|
|
|
# Sony uses a "real" here -- number of days since Dec 31, 1899 |
73
|
|
|
|
|
|
|
ValueConv => 'IsFloat($val) ? ConvertUnixTime(($val - 25569) * 24 * 3600) : $val', |
74
|
|
|
|
|
|
|
PrintConv => '$self->ConvertDateTime($val)', |
75
|
|
|
|
|
|
|
}, |
76
|
|
|
|
|
|
|
'MetaDataList//Duration' => { |
77
|
|
|
|
|
|
|
Name => 'Duration', |
78
|
|
|
|
|
|
|
Groups => { 2 => 'Video' }, |
79
|
|
|
|
|
|
|
PrintConv => 'ConvertDuration($val)', |
80
|
|
|
|
|
|
|
}, |
81
|
|
|
|
|
|
|
'MetaDataList//Geolocation/Latitude' => { |
82
|
|
|
|
|
|
|
Name => 'GPSLatitude', |
83
|
|
|
|
|
|
|
Groups => { 2 => 'Location' }, |
84
|
|
|
|
|
|
|
PrintConv => 'Image::ExifTool::GPS::ToDMS($self, $val, 1, "N")', |
85
|
|
|
|
|
|
|
}, |
86
|
|
|
|
|
|
|
'MetaDataList//Geolocation/Longitude' => { |
87
|
|
|
|
|
|
|
Name => 'GPSLongitude', |
88
|
|
|
|
|
|
|
Groups => { 2 => 'Location' }, |
89
|
|
|
|
|
|
|
PrintConv => 'Image::ExifTool::GPS::ToDMS($self, $val, 1, "E")', |
90
|
|
|
|
|
|
|
}, |
91
|
|
|
|
|
|
|
'MetaDataList//Geolocation/MapDatum' => { |
92
|
|
|
|
|
|
|
Name => 'GPSMapDatum', |
93
|
|
|
|
|
|
|
Groups => { 2 => 'Location' }, |
94
|
|
|
|
|
|
|
}, |
95
|
|
|
|
|
|
|
XMLFileType => { |
96
|
|
|
|
|
|
|
# recognize MODD files by their content |
97
|
|
|
|
|
|
|
RawConv => q{ |
98
|
|
|
|
|
|
|
if ($val eq 'ModdXML' and $$self{FILE_TYPE} eq 'XMP') { |
99
|
|
|
|
|
|
|
$self->OverrideFileType('MODD'); |
100
|
|
|
|
|
|
|
} |
101
|
|
|
|
|
|
|
return $val; |
102
|
|
|
|
|
|
|
}, |
103
|
|
|
|
|
|
|
}, |
104
|
|
|
|
|
|
|
); |
105
|
|
|
|
|
|
|
|
106
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
107
|
|
|
|
|
|
|
# We found a PLIST XML property name/value |
108
|
|
|
|
|
|
|
# Inputs: 0) ExifTool object ref, 1) tag table ref |
109
|
|
|
|
|
|
|
# 2) reference to array of XML property names (last is current property) |
110
|
|
|
|
|
|
|
# 3) property value, 4) attribute hash ref (not used here) |
111
|
|
|
|
|
|
|
# Returns: 1 if valid tag was found |
112
|
|
|
|
|
|
|
sub FoundTag($$$$;$) |
113
|
|
|
|
|
|
|
{ |
114
|
37
|
|
|
37
|
0
|
83
|
my ($et, $tagTablePtr, $props, $val, $attrs) = @_; |
115
|
37
|
50
|
|
|
|
73
|
return 0 unless @$props; |
116
|
37
|
|
|
|
|
123
|
my $verbose = $et->Options('Verbose'); |
117
|
37
|
|
100
|
|
|
88
|
my $keys = $$et{PListKeys} || ( $$et{PListKeys} = [] ); |
118
|
|
|
|
|
|
|
|
119
|
37
|
|
|
|
|
64
|
my $prop = $$props[-1]; |
120
|
37
|
50
|
|
|
|
70
|
if ($verbose > 1) { |
121
|
0
|
|
|
|
|
0
|
$et->VPrint(0, $$et{INDENT}, '[', join('/',@$props), ' = ', |
122
|
|
|
|
|
|
|
$et->Printable($val), "]\n"); |
123
|
|
|
|
|
|
|
} |
124
|
|
|
|
|
|
|
# un-escape XML character entities |
125
|
37
|
|
|
|
|
98
|
$val = Image::ExifTool::XMP::UnescapeXML($val); |
126
|
|
|
|
|
|
|
|
127
|
|
|
|
|
|
|
# handle the various PLIST properties |
128
|
37
|
100
|
66
|
|
|
167
|
if ($prop eq 'data') { |
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
129
|
2
|
50
|
33
|
|
|
16
|
if ($val =~ /^[0-9a-f]+$/ and not length($val) & 0x01) { |
130
|
|
|
|
|
|
|
# MODD files use ASCII-hex encoded "data"... |
131
|
0
|
|
|
|
|
0
|
my $buff = pack('H*', $val); |
132
|
0
|
|
|
|
|
0
|
$val = \$buff; |
133
|
|
|
|
|
|
|
} else { |
134
|
|
|
|
|
|
|
# ...but the PLIST DTD specifies Base64 encoding |
135
|
2
|
|
|
|
|
8
|
$val = Image::ExifTool::XMP::DecodeBase64($val); |
136
|
|
|
|
|
|
|
} |
137
|
|
|
|
|
|
|
} elsif ($prop eq 'date') { |
138
|
2
|
|
|
|
|
8
|
$val = Image::ExifTool::XMP::ConvertXMPDate($val); |
139
|
|
|
|
|
|
|
} elsif ($prop eq 'true' or $prop eq 'false') { |
140
|
1
|
|
|
|
|
3
|
$val = ucfirst $prop; |
141
|
|
|
|
|
|
|
} else { |
142
|
|
|
|
|
|
|
# convert from UTF8 to ExifTool Charset |
143
|
32
|
|
|
|
|
91
|
$val = $et->Decode($val, 'UTF8'); |
144
|
32
|
100
|
|
|
|
70
|
if ($prop eq 'key') { |
145
|
17
|
100
|
|
|
|
37
|
if (@$props <= 3) { # top-level key should be plist/dict/key |
146
|
15
|
|
|
|
|
35
|
@$keys = ( $val ); |
147
|
|
|
|
|
|
|
} else { |
148
|
|
|
|
|
|
|
# save key names to be used in tag name |
149
|
2
|
|
|
|
|
7
|
push @$keys, '' while @$keys < @$props - 3; |
150
|
2
|
|
|
|
|
6
|
pop @$keys while @$keys > @$props - 2; |
151
|
2
|
|
|
|
|
5
|
$$keys[@$props - 3] = $val; |
152
|
|
|
|
|
|
|
} |
153
|
17
|
|
|
|
|
43
|
return 0; |
154
|
|
|
|
|
|
|
} |
155
|
|
|
|
|
|
|
} |
156
|
|
|
|
|
|
|
|
157
|
20
|
100
|
|
|
|
47
|
return 0 unless @$keys; # can't store value if no associated key |
158
|
|
|
|
|
|
|
|
159
|
18
|
|
|
|
|
49
|
my $tag = join '/', @$keys; # generate tag ID from 'key' values |
160
|
18
|
|
|
|
|
40
|
my $tagInfo = $$tagTablePtr{$tag}; |
161
|
18
|
100
|
|
|
|
40
|
unless ($tagInfo) { |
162
|
16
|
50
|
|
|
|
35
|
$et->VPrint(0, $$et{INDENT}, "[adding $tag]\n") if $verbose; |
163
|
|
|
|
|
|
|
# generate tag name from ID |
164
|
16
|
|
|
|
|
28
|
my $name = $tag; |
165
|
16
|
|
|
|
|
25
|
$name =~ s{^MetaDataList//}{}; # shorten long MODD metadata tag names |
166
|
16
|
|
|
|
|
27
|
$name =~ s{//name$}{}; # remove unnecessary MODD "name" property |
167
|
16
|
|
|
|
|
36
|
$name =~ s/([^A-Za-z])([a-z])/$1\u$2/g; # capitalize words |
168
|
16
|
|
|
|
|
30
|
$name =~ tr/-_a-zA-Z0-9//dc; # remove illegal characters |
169
|
16
|
|
|
|
|
63
|
$tagInfo = { Name => ucfirst($name), List => 1 }; |
170
|
16
|
100
|
|
|
|
36
|
if ($prop eq 'date') { |
171
|
2
|
|
|
|
|
8
|
$$tagInfo{Groups}{2} = 'Time'; |
172
|
2
|
|
|
|
|
6
|
$$tagInfo{PrintConv} = '$self->ConvertDateTime($val)'; |
173
|
|
|
|
|
|
|
} |
174
|
16
|
|
|
|
|
48
|
AddTagToTable($tagTablePtr, $tag, $tagInfo); |
175
|
|
|
|
|
|
|
} |
176
|
|
|
|
|
|
|
# allow list-behaviour only for consecutive tags with the same ID |
177
|
18
|
100
|
100
|
|
|
91
|
if ($$et{LastPListTag} and $$et{LastPListTag} ne $tagInfo) { |
178
|
14
|
|
|
|
|
50
|
delete $$et{LIST_TAGS}{$$et{LastPListTag}}; |
179
|
|
|
|
|
|
|
} |
180
|
18
|
|
|
|
|
34
|
$$et{LastPListTag} = $tagInfo; |
181
|
|
|
|
|
|
|
# override file type if applicable |
182
|
18
|
50
|
66
|
|
|
48
|
$et->OverrideFileType($plistType{$tag}) if $plistType{$tag} and $$et{FILE_TYPE} eq 'XMP'; |
183
|
|
|
|
|
|
|
# save the tag |
184
|
18
|
|
|
|
|
64
|
$et->HandleTag($tagTablePtr, $tag, $val); |
185
|
|
|
|
|
|
|
|
186
|
18
|
|
|
|
|
89
|
return 1; |
187
|
|
|
|
|
|
|
} |
188
|
|
|
|
|
|
|
|
189
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
190
|
|
|
|
|
|
|
# Get big-endian 24-bit integer |
191
|
|
|
|
|
|
|
# Inputs: 0) data ref, 1) offset |
192
|
|
|
|
|
|
|
# Returns: integer value |
193
|
|
|
|
|
|
|
sub Get24u($$) |
194
|
|
|
|
|
|
|
{ |
195
|
0
|
|
|
0
|
0
|
0
|
my ($dataPt, $off) = @_; |
196
|
0
|
|
|
|
|
0
|
return unpack 'N', "\0" . substr($$dataPt, $off, 3); |
197
|
|
|
|
|
|
|
} |
198
|
|
|
|
|
|
|
|
199
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
200
|
|
|
|
|
|
|
# Extract object from binary PLIST file at the current file position (ref 2) |
201
|
|
|
|
|
|
|
# Inputs: 0) ExifTool ref, 1) PLIST info ref, 2) parent tag ID (undef for top) |
202
|
|
|
|
|
|
|
# Returns: the object, or undef on error |
203
|
|
|
|
|
|
|
sub ExtractObject($$;$) |
204
|
|
|
|
|
|
|
{ |
205
|
51
|
|
|
51
|
0
|
99
|
my ($et, $plistInfo, $parent) = @_; |
206
|
51
|
|
|
|
|
94
|
my $raf = $$plistInfo{RAF}; |
207
|
51
|
|
|
|
|
77
|
my ($buff, $val); |
208
|
|
|
|
|
|
|
|
209
|
51
|
50
|
|
|
|
135
|
$raf->Read($buff, 1) == 1 or return undef; |
210
|
51
|
|
|
|
|
106
|
my $type = ord($buff) >> 4; |
211
|
51
|
|
|
|
|
84
|
my $size = ord($buff) & 0x0f; |
212
|
51
|
100
|
100
|
|
|
269
|
if ($type == 0) { # null/bool/fill |
|
|
100
|
100
|
|
|
|
|
|
|
50
|
|
|
|
|
|
213
|
1
|
|
|
|
|
11
|
$val = { 0x00=>'', 0x08=>'True', 0x09=>'False', 0x0f=>'' }->{$size}; |
214
|
|
|
|
|
|
|
} elsif ($type == 1 or $type == 2 or $type == 3) { # int, float or date |
215
|
14
|
|
|
|
|
31
|
$size = 1 << $size; |
216
|
14
|
100
|
|
|
|
65
|
my $proc = ($type == 1 ? $readProc{$size} : $readProc{$size + 0x100}) or return undef; |
|
|
50
|
|
|
|
|
|
217
|
14
|
50
|
|
|
|
42
|
$val = &$proc(\$buff, 0) if $raf->Read($buff, $size) == $size; |
218
|
14
|
100
|
66
|
|
|
65
|
if ($type == 3 and defined $val) { # date |
219
|
|
|
|
|
|
|
# dates are referenced to Jan 1, 2001 (11323 days from Unix time zero) |
220
|
3
|
|
|
|
|
19
|
$val = Image::ExifTool::ConvertUnixTime($val + 11323 * 24 * 3600, 1); |
221
|
3
|
|
|
|
|
13
|
$$plistInfo{DateFormat} = 1; |
222
|
|
|
|
|
|
|
} |
223
|
|
|
|
|
|
|
} elsif ($type == 8) { # UID |
224
|
0
|
|
|
|
|
0
|
++$size; |
225
|
0
|
0
|
|
|
|
0
|
$raf->Read($buff, $size) == $size or return undef; |
226
|
0
|
|
|
|
|
0
|
my $proc = $readProc{$size}; |
227
|
0
|
0
|
|
|
|
0
|
if ($proc) { |
|
|
0
|
|
|
|
|
|
228
|
0
|
|
|
|
|
0
|
$val = &$proc(\$buff, 0); |
229
|
|
|
|
|
|
|
} elsif ($size == 16) { |
230
|
0
|
|
|
|
|
0
|
require Image::ExifTool::ASF; |
231
|
0
|
|
|
|
|
0
|
$val = Image::ExifTool::ASF::GetGUID($buff); |
232
|
|
|
|
|
|
|
} else { |
233
|
0
|
|
|
|
|
0
|
$val = "0x" . unpack 'H*', $buff; |
234
|
|
|
|
|
|
|
} |
235
|
|
|
|
|
|
|
} else { |
236
|
|
|
|
|
|
|
# $size is the size of the remaining types |
237
|
36
|
100
|
|
|
|
79
|
if ($size == 0x0f) { |
238
|
|
|
|
|
|
|
# size is stored in extra integer object |
239
|
5
|
|
|
|
|
24
|
$size = ExtractObject($et, $plistInfo); |
240
|
5
|
50
|
33
|
|
|
69
|
return undef unless defined $size and $size =~ /^\d+$/; |
241
|
|
|
|
|
|
|
} |
242
|
36
|
100
|
66
|
|
|
130
|
if ($type == 4) { # data |
|
|
100
|
66
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
243
|
2
|
50
|
33
|
|
|
16
|
if ($size < 1000000 or $et->Options('Binary')) { |
244
|
2
|
50
|
|
|
|
10
|
$raf->Read($buff, $size) == $size or return undef; |
245
|
|
|
|
|
|
|
} else { |
246
|
0
|
|
|
|
|
0
|
$buff = "Binary data $size bytes"; |
247
|
|
|
|
|
|
|
} |
248
|
2
|
|
|
|
|
6
|
$val = \$buff; # (return reference for binary data) |
249
|
|
|
|
|
|
|
} elsif ($type == 5) { # ASCII string |
250
|
26
|
50
|
|
|
|
76
|
$raf->Read($val, $size) == $size or return undef; |
251
|
|
|
|
|
|
|
} elsif ($type == 6) { # UCS-2BE string |
252
|
1
|
|
|
|
|
3
|
$size *= 2; |
253
|
1
|
50
|
|
|
|
4
|
$raf->Read($buff, $size) == $size or return undef; |
254
|
1
|
|
|
|
|
6
|
$val = $et->Decode($buff, 'UCS2'); |
255
|
|
|
|
|
|
|
} elsif ($type == 10 or $type == 12 or $type == 13) { # array, set or dict |
256
|
|
|
|
|
|
|
# the remaining types store a list of references |
257
|
7
|
|
|
|
|
21
|
my $refSize = $$plistInfo{RefSize}; |
258
|
7
|
|
|
|
|
16
|
my $refProc = $$plistInfo{RefProc}; |
259
|
7
|
100
|
|
|
|
21
|
my $num = $type == 13 ? $size * 2 : $size; |
260
|
7
|
|
|
|
|
18
|
my $len = $num * $refSize; |
261
|
7
|
50
|
|
|
|
22
|
$raf->Read($buff, $len) == $len or return undef; |
262
|
7
|
|
|
|
|
20
|
my $table = $$plistInfo{Table}; |
263
|
7
|
|
|
|
|
13
|
my ($i, $ref, @refs, @array); |
264
|
7
|
|
|
|
|
24
|
for ($i=0; $i<$num; ++$i) { |
265
|
39
|
|
|
|
|
92
|
my $ref = &$refProc(\$buff, $i * $refSize); |
266
|
39
|
50
|
|
|
|
88
|
return 0 if $ref >= @$table; |
267
|
39
|
|
|
|
|
86
|
push @refs, $ref; |
268
|
|
|
|
|
|
|
} |
269
|
7
|
100
|
|
|
|
31
|
if ($type == 13) { # dict |
270
|
|
|
|
|
|
|
# prevent infinite recursion |
271
|
3
|
50
|
66
|
|
|
17
|
if (defined $parent and length $parent > 1000) { |
272
|
0
|
|
|
|
|
0
|
$et->WarnOnce('Possible deep recursion while parsing PLIST'); |
273
|
0
|
|
|
|
|
0
|
return undef; |
274
|
|
|
|
|
|
|
} |
275
|
3
|
|
|
|
|
8
|
my $tagTablePtr = $$plistInfo{TagTablePtr}; |
276
|
3
|
|
|
|
|
18
|
my $verbose = $et->Options('Verbose'); |
277
|
3
|
|
|
|
|
9
|
$val = { }; # initialize return dictionary (will stay empty if tags are saved) |
278
|
3
|
|
|
|
|
13
|
for ($i=0; $i<$size; ++$i) { |
279
|
|
|
|
|
|
|
# get the entry key |
280
|
15
|
50
|
|
|
|
58
|
$raf->Seek($$table[$refs[$i]], 0) or return undef; |
281
|
15
|
|
|
|
|
68
|
my $key = ExtractObject($et, $plistInfo); |
282
|
15
|
50
|
33
|
|
|
68
|
next unless defined $key and length $key; # silently ignore bad dict entries |
283
|
|
|
|
|
|
|
# get the entry value |
284
|
15
|
50
|
|
|
|
52
|
$raf->Seek($$table[$refs[$i+$size]], 0) or return undef; |
285
|
|
|
|
|
|
|
# generate an ID for this tag |
286
|
15
|
100
|
|
|
|
47
|
my $tag = defined $parent ? "$parent/$key" : $key; |
287
|
15
|
|
|
|
|
38
|
undef $$plistInfo{DateFormat}; |
288
|
15
|
|
|
|
|
38
|
my $obj = ExtractObject($et, $plistInfo, $tag); |
289
|
15
|
50
|
|
|
|
41
|
next if not defined $obj; |
290
|
15
|
50
|
|
|
|
39
|
unless ($tagTablePtr) { |
291
|
0
|
0
|
|
|
|
0
|
$$val{$key} = $obj if defined $obj; |
292
|
0
|
|
|
|
|
0
|
next; |
293
|
|
|
|
|
|
|
} |
294
|
15
|
100
|
|
|
|
56
|
next if ref($obj) eq 'HASH'; |
295
|
14
|
|
|
|
|
55
|
my $tagInfo = $et->GetTagInfo($tagTablePtr, $tag); |
296
|
14
|
50
|
|
|
|
38
|
unless ($tagInfo) { |
297
|
0
|
0
|
|
|
|
0
|
$et->VPrint(0, $$et{INDENT}, "[adding $tag]\n") if $verbose; |
298
|
0
|
|
|
|
|
0
|
my $name = $tag; |
299
|
0
|
|
|
|
|
0
|
$name =~ s/([^A-Za-z])([a-z])/$1\u$2/g; # capitalize words |
300
|
0
|
|
|
|
|
0
|
$name =~ tr/-_a-zA-Z0-9//dc; # remove illegal characters |
301
|
0
|
|
|
|
|
0
|
$tagInfo = { Name => ucfirst($name), List => 1 }; |
302
|
0
|
0
|
|
|
|
0
|
if ($$plistInfo{DateFormat}) { |
303
|
0
|
|
|
|
|
0
|
$$tagInfo{Groups}{2} = 'Time'; |
304
|
0
|
|
|
|
|
0
|
$$tagInfo{PrintConv} = '$self->ConvertDateTime($val)'; |
305
|
|
|
|
|
|
|
} |
306
|
0
|
|
|
|
|
0
|
AddTagToTable($tagTablePtr, $tag, $tagInfo); |
307
|
|
|
|
|
|
|
} |
308
|
|
|
|
|
|
|
# allow list-behaviour only for consecutive tags with the same ID |
309
|
14
|
100
|
66
|
|
|
77
|
if ($$et{LastPListTag} and $$et{LastPListTag} ne $tagInfo) { |
310
|
12
|
|
|
|
|
57
|
delete $$et{LIST_TAGS}{$$et{LastPListTag}}; |
311
|
|
|
|
|
|
|
} |
312
|
14
|
|
|
|
|
33
|
$$et{LastPListTag} = $tagInfo; |
313
|
14
|
|
|
|
|
41
|
$et->HandleTag($tagTablePtr, $tag, $obj); |
314
|
|
|
|
|
|
|
} |
315
|
|
|
|
|
|
|
} else { |
316
|
|
|
|
|
|
|
# extract the referenced objects |
317
|
4
|
|
|
|
|
12
|
foreach $ref (@refs) { |
318
|
9
|
50
|
|
|
|
26
|
$raf->Seek($$table[$ref], 0) or return undef; # seek to this object |
319
|
9
|
|
|
|
|
39
|
$val = ExtractObject($et, $plistInfo, $parent); |
320
|
9
|
50
|
33
|
|
|
41
|
next unless defined $val and ref $val ne 'HASH'; |
321
|
9
|
|
|
|
|
21
|
push @array, $val; |
322
|
|
|
|
|
|
|
} |
323
|
4
|
|
|
|
|
15
|
$val = \@array; |
324
|
|
|
|
|
|
|
} |
325
|
|
|
|
|
|
|
} |
326
|
|
|
|
|
|
|
} |
327
|
51
|
|
|
|
|
135
|
return $val; |
328
|
|
|
|
|
|
|
} |
329
|
|
|
|
|
|
|
|
330
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
331
|
|
|
|
|
|
|
# Process binary PLIST data (ref 2) |
332
|
|
|
|
|
|
|
# Inputs: 0) ExifTool object ref, 1) DirInfo ref, 2) tag table ref |
333
|
|
|
|
|
|
|
# Returns: 1 on success (and returns plist value as $$dirInfo{Value}) |
334
|
|
|
|
|
|
|
sub ProcessBinaryPLIST($$;$) |
335
|
|
|
|
|
|
|
{ |
336
|
7
|
|
|
7
|
0
|
20
|
my ($et, $dirInfo, $tagTablePtr) = @_; |
337
|
7
|
|
|
|
|
14
|
my ($i, $buff, @table); |
338
|
7
|
|
|
|
|
18
|
my $dataPt = $$dirInfo{DataPt}; |
339
|
|
|
|
|
|
|
|
340
|
7
|
|
|
|
|
39
|
$et->VerboseDir('Binary PLIST'); |
341
|
7
|
|
|
|
|
27
|
SetByteOrder('MM'); |
342
|
|
|
|
|
|
|
|
343
|
7
|
100
|
|
|
|
48
|
if ($dataPt) { |
344
|
6
|
|
|
|
|
19
|
my $start = $$dirInfo{DirStart}; |
345
|
6
|
100
|
33
|
|
|
57
|
if ($start or ($$dirInfo{DirLen} and $$dirInfo{DirLen} != length $$dataPt)) { |
|
|
|
66
|
|
|
|
|
346
|
1
|
|
50
|
|
|
6
|
my $buf2 = substr($$dataPt, $start || 0, $$dirInfo{DirLen}); |
347
|
1
|
|
|
|
|
25
|
$$dirInfo{RAF} = new File::RandomAccess(\$buf2); |
348
|
|
|
|
|
|
|
} else { |
349
|
5
|
|
|
|
|
27
|
$$dirInfo{RAF} = new File::RandomAccess($dataPt); |
350
|
|
|
|
|
|
|
} |
351
|
6
|
|
100
|
|
|
37
|
my $strt = $$dirInfo{DirStart} || 0; |
352
|
|
|
|
|
|
|
} |
353
|
|
|
|
|
|
|
# read and parse the trailer |
354
|
7
|
50
|
|
|
|
37
|
my $raf = $$dirInfo{RAF} or return 0; |
355
|
7
|
50
|
33
|
|
|
27
|
$raf->Seek(-32,2) and $raf->Read($buff,32)==32 or return 0; |
356
|
7
|
|
|
|
|
37
|
my $intSize = Get8u(\$buff, 6); |
357
|
7
|
|
|
|
|
23
|
my $refSize = Get8u(\$buff, 7); |
358
|
7
|
|
|
|
|
53
|
my $numObj = Get64u(\$buff, 8); |
359
|
7
|
|
|
|
|
24
|
my $topObj = Get64u(\$buff, 16); |
360
|
7
|
|
|
|
|
34
|
my $tableOff = Get64u(\$buff, 24); |
361
|
|
|
|
|
|
|
|
362
|
7
|
50
|
|
|
|
28
|
return 0 if $topObj >= $numObj; |
363
|
7
|
50
|
|
|
|
31
|
my $intProc = $readProc{$intSize} or return 0; |
364
|
7
|
50
|
|
|
|
89
|
my $refProc = $readProc{$refSize} or return 0; |
365
|
|
|
|
|
|
|
|
366
|
|
|
|
|
|
|
# read and parse the offset table |
367
|
7
|
|
|
|
|
13
|
my $tableSize = $intSize * $numObj; |
368
|
7
|
50
|
33
|
|
|
37
|
$raf->Seek($tableOff, 0) and $raf->Read($buff, $tableSize) == $tableSize or return 0; |
369
|
7
|
|
|
|
|
31
|
for ($i=0; $i<$numObj; ++$i) { |
370
|
46
|
|
|
|
|
106
|
push @table, &$intProc(\$buff, $i * $intSize); |
371
|
|
|
|
|
|
|
} |
372
|
7
|
|
|
|
|
53
|
my %plistInfo = ( |
373
|
|
|
|
|
|
|
RAF => $raf, |
374
|
|
|
|
|
|
|
RefSize => $refSize, |
375
|
|
|
|
|
|
|
RefProc => $refProc, |
376
|
|
|
|
|
|
|
Table => \@table, |
377
|
|
|
|
|
|
|
TagTablePtr => $tagTablePtr, |
378
|
|
|
|
|
|
|
); |
379
|
|
|
|
|
|
|
# position file pointer at the top object, and extract it |
380
|
7
|
50
|
|
|
|
28
|
$raf->Seek($table[$topObj], 0) or return 0; |
381
|
7
|
|
|
|
|
35
|
$$dirInfo{Value} = ExtractObject($et, \%plistInfo); |
382
|
7
|
50
|
|
|
|
52
|
return defined $$dirInfo{Value} ? 1 : 0; |
383
|
|
|
|
|
|
|
} |
384
|
|
|
|
|
|
|
|
385
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
386
|
|
|
|
|
|
|
# Extract information from a PLIST file |
387
|
|
|
|
|
|
|
# Inputs: 0) ExifTool object ref, 1) dirInfo ref, 2) tag table ref |
388
|
|
|
|
|
|
|
# Returns: 1 on success, 0 if this wasn't valid PLIST |
389
|
|
|
|
|
|
|
sub ProcessPLIST($$;$) |
390
|
|
|
|
|
|
|
{ |
391
|
6
|
|
|
6
|
0
|
25
|
my ($et, $dirInfo, $tagTablePtr) = @_; |
392
|
|
|
|
|
|
|
|
393
|
|
|
|
|
|
|
# process XML PLIST data using the XMP module |
394
|
6
|
|
|
|
|
24
|
$$dirInfo{XMPParseOpts}{FoundProc} = \&FoundTag; |
395
|
6
|
|
|
|
|
36
|
my $result = Image::ExifTool::XMP::ProcessXMP($et, $dirInfo, $tagTablePtr); |
396
|
6
|
|
|
|
|
31
|
delete $$dirInfo{XMPParseOpts}; |
397
|
|
|
|
|
|
|
|
398
|
6
|
100
|
|
|
|
31
|
unless ($result) { |
399
|
4
|
|
|
|
|
12
|
my $buff; |
400
|
4
|
50
|
|
|
|
17
|
my $raf = $$dirInfo{RAF} or return 0; |
401
|
4
|
50
|
33
|
|
|
22
|
$raf->Seek(0,0) and $raf->Read($buff, 64) or return 0; |
402
|
4
|
100
|
33
|
|
|
49
|
if ($buff =~ /^bplist0/) { |
|
|
50
|
33
|
|
|
|
|
403
|
|
|
|
|
|
|
# binary PLIST file |
404
|
1
|
|
|
|
|
7
|
my $tagTablePtr = GetTagTable('Image::ExifTool::PLIST::Main'); |
405
|
1
|
|
|
|
|
6
|
$et->SetFileType('PLIST', 'application/x-plist'); |
406
|
1
|
|
|
|
|
6
|
$$et{SET_GROUP1} = 'PLIST'; |
407
|
1
|
50
|
|
|
|
8
|
unless (ProcessBinaryPLIST($et, $dirInfo, $tagTablePtr)) { |
408
|
0
|
|
|
|
|
0
|
$et->Error('Error reading binary PLIST file'); |
409
|
|
|
|
|
|
|
} |
410
|
1
|
|
|
|
|
3
|
delete $$et{SET_GROUP1}; |
411
|
1
|
|
|
|
|
3
|
$result = 1; |
412
|
|
|
|
|
|
|
} elsif ($$et{FILE_EXT} and $$et{FILE_EXT} eq 'PLIST' and |
413
|
|
|
|
|
|
|
$buff =~ /^\xfe\xff\x00/) |
414
|
|
|
|
|
|
|
{ |
415
|
|
|
|
|
|
|
# (have seen very old PLIST files encoded as UCS-2BE with leading BOM) |
416
|
0
|
|
|
|
|
0
|
$et->Error('Old PLIST format currently not supported'); |
417
|
0
|
|
|
|
|
0
|
$result = 1; |
418
|
|
|
|
|
|
|
} |
419
|
|
|
|
|
|
|
} |
420
|
6
|
|
|
|
|
22
|
return $result; |
421
|
|
|
|
|
|
|
} |
422
|
|
|
|
|
|
|
|
423
|
|
|
|
|
|
|
1; # end |
424
|
|
|
|
|
|
|
|
425
|
|
|
|
|
|
|
__END__ |