PLIST.pm 17 KB

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