iWork.pm 7.4 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223
  1. #------------------------------------------------------------------------------
  2. # File: iWork.pm
  3. #
  4. # Description: Read Apple iWork '09 XML+ZIP files
  5. #
  6. # Revisions: 2009/11/11 - P. Harvey Created
  7. #------------------------------------------------------------------------------
  8. package Image::ExifTool::iWork;
  9. use strict;
  10. use vars qw($VERSION);
  11. use Image::ExifTool qw(:DataAccess :Utils);
  12. use Image::ExifTool::XMP;
  13. use Image::ExifTool::ZIP;
  14. $VERSION = '1.04';
  15. # test for recognized iWork document extensions and outer XML elements
  16. my %iWorkType = (
  17. # file extensions
  18. NUMBERS => 'NUMBERS',
  19. PAGES => 'PAGES',
  20. KEY => 'KEY',
  21. KTH => 'KTH',
  22. NMBTEMPLATE => 'NMBTEMPLATE',
  23. # we don't support double extensions --
  24. # "PAGES.TEMPLATE" => 'Apple Pages Template',
  25. # outer XML elements
  26. 'ls:document' => 'NUMBERS',
  27. 'sl:document' => 'PAGES',
  28. 'key:presentation' => 'KEY',
  29. );
  30. # MIME types for iWork files (Apple has not registered these yet, but these
  31. # are my best guess after doing some googling. I'm not 100% sure what "sff"
  32. # indicates, but I think it refers to the new "flattened" package format)
  33. my %mimeType = (
  34. 'NUMBERS' => 'application/x-iwork-numbers-sffnumbers',
  35. 'PAGES' => 'application/x-iwork-pages-sffpages',
  36. 'KEY' => 'application/x-iWork-keynote-sffkey',
  37. 'NMBTEMPLATE' => 'application/x-iwork-numbers-sfftemplate',
  38. 'PAGES.TEMPLATE'=> 'application/x-iwork-pages-sfftemplate',
  39. 'KTH' => 'application/x-iWork-keynote-sffkth',
  40. );
  41. # iWork tags
  42. %Image::ExifTool::iWork::Main = (
  43. GROUPS => { 0 => 'XML', 1 => 'XML', 2 => 'Document' },
  44. PROCESS_PROC => \&Image::ExifTool::XMP::ProcessXMP,
  45. VARS => { NO_ID => 1 },
  46. NOTES => q{
  47. The Apple iWork '09 file format is a ZIP archive containing XML files
  48. similar to the Office Open XML (OOXML) format. Metadata tags in iWork
  49. files are extracted even if they don't appear below.
  50. },
  51. authors => { Name => 'Author', Groups => { 2 => 'Author' } },
  52. comment => { },
  53. copyright => { Groups => { 2 => 'Author' } },
  54. keywords => { },
  55. projects => { List => 1 },
  56. title => { },
  57. );
  58. #------------------------------------------------------------------------------
  59. # Generate a tag ID for this XML tag
  60. # Inputs: 0) tag property name list ref
  61. # Returns: tagID
  62. sub GetTagID($)
  63. {
  64. my $props = shift;
  65. return 0 if $$props[-1] =~ /^\w+:ID$/; # ignore ID tags
  66. return ($$props[0] =~ /^.*?:(.*)/) ? $1 : $$props[0];
  67. }
  68. #------------------------------------------------------------------------------
  69. # We found an XMP property name/value
  70. # Inputs: 0) ExifTool object ref, 1) tag table ref
  71. # 2) reference to array of XMP property names (last is current property)
  72. # 3) property value, 4) attribute hash ref (not used here)
  73. # Returns: 1 if valid tag was found
  74. sub FoundTag($$$$;$)
  75. {
  76. my ($et, $tagTablePtr, $props, $val, $attrs) = @_;
  77. return 0 unless @$props;
  78. my $verbose = $et->Options('Verbose');
  79. $et->VPrint(0, " | - Tag '", join('/',@$props), "'\n") if $verbose > 1;
  80. # un-escape XML character entities
  81. $val = Image::ExifTool::XMP::UnescapeXML($val);
  82. # convert from UTF8 to ExifTool Charset
  83. $val = $et->Decode($val, 'UTF8');
  84. my $tag = GetTagID($props) or return 0;
  85. # add any unknown tags to table
  86. unless ($$tagTablePtr{$tag}) {
  87. $et->VPrint(0, " [adding $tag]\n") if $verbose;
  88. AddTagToTable($tagTablePtr, $tag, { Name => ucfirst $tag });
  89. }
  90. # save the tag
  91. $et->HandleTag($tagTablePtr, $tag, $val);
  92. return 1;
  93. }
  94. #------------------------------------------------------------------------------
  95. # Extract information from an iWork file
  96. # Inputs: 0) ExifTool object reference, 1) dirInfo reference
  97. # Returns: 1
  98. # Notes: Upon entry to this routine, the file type has already been verified
  99. # as ZIP and the dirInfo hash contains a 'ZIP' Archive::Zip object reference
  100. sub Process_iWork($$)
  101. {
  102. my ($et, $dirInfo) = @_;
  103. my $zip = $$dirInfo{ZIP};
  104. my ($type, $index, $indexFile, $status);
  105. # try to determine the file type
  106. local $SIG{'__WARN__'} = \&Image::ExifTool::ZIP::WarnProc;
  107. # trust type given by file extension if available
  108. $type = $iWorkType{$$et{FILE_EXT}} if $$et{FILE_EXT};
  109. unless ($type) {
  110. # read the index file
  111. my @members = $zip->membersMatching('^index\.(xml|apxl)$');
  112. if (@members) {
  113. ($index, $status) = $zip->contents($members[0]);
  114. unless ($status) {
  115. $indexFile = $members[0]->fileName();
  116. if ($index =~ /^\s*<\?xml version=[^<]+<(\w+:\w+)/s) {
  117. $type = $iWorkType{$1} if $iWorkType{$1};
  118. }
  119. }
  120. }
  121. $type or $type = 'ZIP'; # assume ZIP by default
  122. }
  123. $et->SetFileType($type, $mimeType{$type});
  124. my @members = $zip->members();
  125. my $docNum = 0;
  126. my $member;
  127. foreach $member (@members) {
  128. # get filename of this ZIP member
  129. my $file = $member->fileName();
  130. next unless defined $file;
  131. $et->VPrint(0, "File: $file\n");
  132. # set the document number and extract ZIP tags
  133. $$et{DOC_NUM} = ++$docNum;
  134. Image::ExifTool::ZIP::HandleMember($et, $member);
  135. # process only the index XML and JPEG thumbnail files
  136. next unless $file =~ m{^(index\.(xml|apxl)|QuickLook/Thumbnail\.jpg)$}i;
  137. # get the file contents if necessary
  138. # (CAREFUL! $buff MUST be local since we hand off a value ref to PreviewImage)
  139. my ($buff, $buffPt);
  140. if ($indexFile and $indexFile eq $file) {
  141. # use the index file we already loaded
  142. $buffPt = \$index;
  143. } else {
  144. ($buff, $status) = $zip->contents($member);
  145. $status and $et->Warn("Error extracting $file"), next;
  146. $buffPt = \$buff;
  147. }
  148. # extract JPEG as PreviewImage (should only be QuickLook/Thumbnail.jpg)
  149. if ($file =~ /\.jpg$/) {
  150. $et->FoundTag('PreviewImage', $buffPt);
  151. next;
  152. }
  153. # process "metadata" section of XML index file
  154. next unless $$buffPt =~ /<(\w+):metadata>/g;
  155. my $ns = $1;
  156. my $p1 = pos $$buffPt;
  157. next unless $$buffPt =~ m{</${ns}:metadata>}g;
  158. # construct XML data from "metadata" section only
  159. $$buffPt = '<?xml version="1.0"?>' . substr($$buffPt, $p1, pos($$buffPt)-$p1);
  160. my %dirInfo = (
  161. DataPt => $buffPt,
  162. DirLen => length $$buffPt,
  163. DataLen => length $$buffPt,
  164. XMPParseOpts => {
  165. FoundProc => \&FoundTag,
  166. },
  167. );
  168. my $tagTablePtr = GetTagTable('Image::ExifTool::iWork::Main');
  169. $et->ProcessDirectory(\%dirInfo, $tagTablePtr);
  170. undef $$buffPt; # (free memory now)
  171. }
  172. delete $$et{DOC_NUM};
  173. return 1;
  174. }
  175. 1; # end
  176. __END__
  177. =head1 NAME
  178. Image::ExifTool::iWork - Read Apple iWork '09 XML+ZIP files
  179. =head1 SYNOPSIS
  180. This module is used by Image::ExifTool
  181. =head1 DESCRIPTION
  182. This module contains definitions required by Image::ExifTool to extract meta
  183. information from Apple iWork '09 XML+ZIP files.
  184. =head1 AUTHOR
  185. Copyright 2003-2016, Phil Harvey (phil at owl.phy.queensu.ca)
  186. This library is free software; you can redistribute it and/or modify it
  187. under the same terms as Perl itself.
  188. =head1 SEE ALSO
  189. L<Image::ExifTool::TagNames/iWork Tags>,
  190. L<Image::ExifTool::TagNames/OOXML Tags>,
  191. L<Image::ExifTool(3pm)|Image::ExifTool>
  192. =cut