RTF.pm 13 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383
  1. #------------------------------------------------------------------------------
  2. # File: RTF.pm
  3. #
  4. # Description: Read Rich Text Format meta information
  5. #
  6. # Revisions: 2010/06/17 - P. Harvey Created
  7. #
  8. # References: 1) http://download.microsoft.com/download/2/f/5/2f599e18-07ee-4ec5-a1e7-f4e6a9423592/Word2007RTFSpec9.doc
  9. # 2) http://search.cpan.org/dist/RTF-Writer/lib/RTF/Cookbook.pod
  10. #------------------------------------------------------------------------------
  11. package Image::ExifTool::RTF;
  12. use strict;
  13. use vars qw($VERSION);
  14. use Image::ExifTool qw(:DataAccess :Utils);
  15. $VERSION = '1.02';
  16. sub ProcessUserProps($$$);
  17. # supported RTF character entities
  18. my %rtfEntity = (
  19. par => 0x0a,
  20. tab => 0x09,
  21. endash => 0x2013,
  22. emdash => 0x2014,
  23. lquote => 0x2018,
  24. rquote => 0x2019,
  25. ldblquote => 0x201c,
  26. rdblquote => 0x201d,
  27. bullet => 0x2022,
  28. );
  29. # RTF tags (ref 1)
  30. %Image::ExifTool::RTF::Main = (
  31. GROUPS => { 2 => 'Document' },
  32. NOTES => q{
  33. This table lists standard tags of the RTF information group, but ExifTool
  34. will also extract any non-standard tags found in this group. As well,
  35. ExifTool will extract any custom properties that are found. See
  36. L<http://www.microsoft.com/en-ca/download/details.aspx?id=10725> for the
  37. specification.
  38. },
  39. title => { },
  40. subject => { },
  41. author => { Groups => { 2 => 'Author' } },
  42. manager => { },
  43. company => { },
  44. copyright=> { Groups => { 2 => 'Author' } }, # (written by Apple TextEdit)
  45. operator => { Name => 'LastModifiedBy' },
  46. category => { },
  47. keywords => { },
  48. comment => { },
  49. doccomm => { Name => 'Comments' },
  50. hlinkbase=> { Name => 'HyperlinkBase' },
  51. creatim => {
  52. Name => 'CreateDate',
  53. Format => 'date',
  54. Groups => { 2 => 'Time' },
  55. PrintConv => '$self->ConvertDateTime($val)',
  56. },
  57. revtim => {
  58. Name => 'ModifyDate',
  59. Format => 'date',
  60. Groups => { 2 => 'Time' },
  61. PrintConv => '$self->ConvertDateTime($val)',
  62. },
  63. printim => {
  64. Name => 'LastPrinted',
  65. Format => 'date',
  66. Groups => { 2 => 'Time' },
  67. PrintConv => '$self->ConvertDateTime($val)',
  68. },
  69. buptim => {
  70. Name => 'BackupTime',
  71. Format => 'date',
  72. Groups => { 2 => 'Time' },
  73. PrintConv => '$self->ConvertDateTime($val)',
  74. },
  75. edmins => {
  76. Name => 'TotalEditTime', # in minutes
  77. PrintConv => 'ConvertTimeSpan($val, 60)',
  78. },
  79. nofpages => { Name => 'Pages' },
  80. nofwords => { Name => 'Words' },
  81. nofchars => { Name => 'Characters' },
  82. nofcharsws=>{
  83. Name => 'CharactersWithSpaces',
  84. Notes => q{
  85. according to the 2007 Microsoft RTF specification this is clearly the number
  86. of characters NOT including spaces, but Microsoft Word writes this as the
  87. number WITH spaces, so ExifTool names this tag according to the de facto
  88. standard
  89. },
  90. },
  91. id => { Name => 'InternalIDNumber' },
  92. version => { Name => 'RevisionNumber' },
  93. vern => { Name => 'InternalVersionNumber' },
  94. );
  95. # lookup for user-defined properties
  96. # (none are pre-defined and this table doesn't appear in the docs)
  97. %Image::ExifTool::RTF::UserProps = (
  98. GROUPS => { 2 => 'Document' },
  99. );
  100. #------------------------------------------------------------------------------
  101. # Read to nested closing curly bracket "}"
  102. # Inputs: 0) data ref, 1) optional RAF ref to read more data if available
  103. # Returns: text inside brackets, or undef on error
  104. # Notes: On entry the current position in the data must be set to immediately
  105. # after the command that opens the bracket. On return the current
  106. # position is immediately following the closing brace if the return
  107. # value is defined.
  108. sub ReadToNested($;$)
  109. {
  110. my ($dataPt, $raf) = @_;
  111. my $pos = pos $$dataPt;
  112. my $level = 1;
  113. for (;;) {
  114. # look for the next bracket
  115. unless ($$dataPt =~ /(\\*)([{}])/g) {
  116. # must read some more data
  117. my $p = length $$dataPt;
  118. my $buff;
  119. last unless $raf and $raf->Read($buff, 65536);
  120. $$dataPt .= $buff;
  121. # rewind position to include any leading backslashes
  122. --$p while $p and substr($$dataPt, $p - 1, 1) eq '\\';
  123. pos($$dataPt) = $p; # set position to continue search
  124. next;
  125. }
  126. # bracket is escaped if preceded by an odd number of backslashes
  127. next if $1 and length($1) & 0x01;
  128. $2 eq '{' and ++$level, next;
  129. next unless --$level <= 0;
  130. return substr($$dataPt, $pos, pos($$dataPt) - $pos - 1);
  131. }
  132. return undef;
  133. }
  134. #------------------------------------------------------------------------------
  135. # Unescape RTF escape sequences
  136. # Inputs: 0) ExifTool ref, 1) RTF text, 2) RTF character set (for hex characters)
  137. # Returns: Unescaped text (in current ExifTool Charset)
  138. sub UnescapeRTF($$$)
  139. {
  140. my ($et, $val, $charset) = @_;
  141. # return now unless we have a control sequence
  142. unless ($val =~ /\\/) {
  143. $val =~ tr/\n\r//d; # ignore CR's and LF's
  144. return $val;
  145. }
  146. # CR/LF is signficant if it terminates a control sequence (so change these to a space)
  147. $val =~ s/(^|[^\\])((?:\\\\)*)(\\[a-zA-Z]+(?:-?\d+)?)[\n\r]/$1$2$3 /g;
  148. # protect the newline control sequence by converting to a \par command
  149. $val =~ s/(^|[^\\])((?:\\\\)*)(\\[\n\r])/$1$2\\par /g;
  150. # all other CR/LF's are ignored (so delete them)
  151. $val =~ tr/\n\r//d;
  152. my $rtnVal = '';
  153. my $len = length $val;
  154. my $skip = 1; # default Unicode skip count
  155. my $p0 = 0;
  156. for (;;) {
  157. # find next backslash
  158. my $p1 = ($val =~ /\\/g) ? pos($val) : $len + 1;
  159. # add text up to start of this control sequence (or up to end)
  160. my $n = $p1 - $p0 - 1;
  161. $rtnVal .= substr($val, $p0, $n) if $n > 0;
  162. # all done if at the end or if control sequence is empty
  163. last if $p1 >= $len;
  164. # look for an ASCII-letter control word or Unicode control
  165. if ($val =~ /\G([a-zA-Z]+)(-?\d+)? ?/g) {
  166. # interpret command if recognized
  167. if ($1 eq 'uc') { # \ucN
  168. $skip = $2;
  169. } elsif ($1 eq 'u') { # \uN
  170. require Image::ExifTool::Charset;
  171. $rtnVal .= Image::ExifTool::Charset::Recompose($et, [$2]);
  172. if ($skip) {
  173. # must skip the specified number of characters
  174. # (not simple because RTF control words count as a single character)
  175. last unless $val =~ /\G([^\\]|\\([a-zA-Z]+)(-?\d+)? ?|\\'.{2}|\\.){$skip}/g;
  176. }
  177. } elsif ($rtfEntity{$1}) {
  178. require Image::ExifTool::Charset;
  179. $rtnVal .= Image::ExifTool::Charset::Recompose($et, [$rtfEntity{$1}]);
  180. } # (else ignore the command)
  181. } else {
  182. my $ch = substr($val, $p1, 1);
  183. if ($ch eq "'") {
  184. # hex character code
  185. last if $p1 + 3 > $len;
  186. my $hex = substr($val, $p1 + 1, 2);
  187. if ($hex =~ /^[0-9a-fA-F]{2}$/) {
  188. require Image::ExifTool::Charset;
  189. $rtnVal .= $et->Decode(chr(hex($hex)), $charset);
  190. }
  191. pos($val) = $p1 + 3; # skip to after the hex code
  192. } else {
  193. # assume a standard control symbol (\, {, }, etc)
  194. # (note, this may not be valid for some uncommon
  195. # control symbols like \~ for non-breaking space)
  196. $rtnVal .= $ch;
  197. pos($val) = $p1 + 1; # skip to after this character
  198. }
  199. }
  200. $p0 = pos($val);
  201. }
  202. return $rtnVal;
  203. }
  204. #------------------------------------------------------------------------------
  205. # Read information in a RTF document
  206. # Inputs: 0) ExifTool ref, 1) dirInfo ref
  207. # Returns: 1 on success, 0 if this wasn't a valid RTF file
  208. sub ProcessRTF($$)
  209. {
  210. my ($et, $dirInfo) = @_;
  211. my $raf = $$dirInfo{RAF};
  212. my ($buff, $buf2, $cs);
  213. return 0 unless $raf->Read($buff, 64) and $raf->Seek(0,0);
  214. return 0 unless $buff =~ /^[\n\r]*\{[\n\r]*\\rtf[^a-zA-Z]/;
  215. $et->SetFileType();
  216. #
  217. # determine the RTF character set
  218. #
  219. if ($buff=~ /\\ansicpg(\d*)/) {
  220. $cs = "cp$1";
  221. } elsif ($buff=~ /\\(ansi|mac|pc|pca)[^a-zA-Z]/) {
  222. my %trans = (
  223. ansi => 'Latin',
  224. mac => 'MacRoman',
  225. pc => 'cp437',
  226. pca => 'cp850',
  227. );
  228. $cs = $trans{$1};
  229. } else {
  230. $et->Warn('Unspecified RTF encoding. Will assume Latin');
  231. $cs = 'Latin';
  232. }
  233. my $charset = $Image::ExifTool::charsetName{lc $cs};
  234. unless ($charset) {
  235. $et->Warn("Unsupported RTF encoding $cs. Will assume Latin.");
  236. $charset = 'Latin';
  237. }
  238. my $tagTablePtr = GetTagTable('Image::ExifTool::RTF::Main');
  239. undef $buff;
  240. #
  241. # scan for \info group
  242. #
  243. for (;;) {
  244. $raf->Read($buf2, 65536) or last;
  245. if (defined $buff) {
  246. # read more but leave some overlap for the match
  247. $buff = substr($buff, -16) . $buf2;
  248. } else {
  249. $buff = $buf2;
  250. }
  251. next unless $buff =~ /[^\\]\{[\n\r]*\\info([^a-zA-Z])/g;
  252. # anything but a space is included in the contents
  253. pos($buff) = pos($buff) - 1 if $1 ne ' ';
  254. my $info = ReadToNested(\$buff, $raf);
  255. unless (defined $info) {
  256. $et->Warn('Unterminated information group');
  257. last;
  258. }
  259. # process info commands (eg. "\author", "\*\copyright");
  260. while ($info =~ /\{[\n\r]*(\\\*[\n\r]*)?\\([a-zA-Z]+)([^a-zA-Z])/g) {
  261. pos($info) = pos($info) - 1 if $3 ne ' ';
  262. my $tag = $2;
  263. my $val = ReadToNested(\$info);
  264. last unless defined $val;
  265. my $tagInfo = $$tagTablePtr{$tag};
  266. if ($tagInfo and $$tagInfo{Format} and $$tagInfo{Format} eq 'date') {
  267. # parse RTF date commands
  268. my %idx = (yr=>0,mo=>1,dy=>2,hr=>3,min=>4,sec=>5);
  269. my @t = (0) x 6;
  270. while ($val =~ /\\([a-z]+)(\d+)/g) {
  271. next unless defined $idx{$1};
  272. $t[$idx{$1}] = $2;
  273. }
  274. $val = sprintf("%.4d:%.2d:%.2d %.2d:%.2d:%.2d", @t);
  275. } else {
  276. # unescape RTF string value
  277. $val = UnescapeRTF($et, $val, $charset);
  278. }
  279. # create tagInfo for unknown tags
  280. if (not $tagInfo) {
  281. AddTagToTable($tagTablePtr, $tag, { Name => ucfirst($tag) });
  282. }
  283. $et->HandleTag($tagTablePtr, $tag, $val);
  284. }
  285. }
  286. return 1 unless defined $buff;
  287. #
  288. # scan for \userprops (but don't read more from file to find the start of this command)
  289. #
  290. pos($buff) = 0;
  291. while ($buff =~ /[^\\]\{[\n\r]*\\\*[\n\r]*\\userprops([^a-zA-Z])/g) {
  292. # Note: The RTF spec places brackets around each propinfo structure,
  293. # but Microsoft Word doesn't write it this way, so tolerate either.
  294. pos($buff) = pos($buff) - 1 if $1 ne ' ';
  295. my $props = ReadToNested(\$buff, $raf);
  296. $tagTablePtr = Image::ExifTool::GetTagTable('Image::ExifTool::RTF::UserProps');
  297. unless (defined $props) {
  298. $et->Warn('Unterminated user properties');
  299. last;
  300. }
  301. # process user properties
  302. my $tag;
  303. while ($props =~ /\{[\n\r]*(\\\*[\n\r]*)?\\([a-zA-Z]+)([^a-zA-Z])/g) {
  304. pos($props) = pos($props) - 1 if $3 ne ' ';
  305. my $t = $2;
  306. my $val = ReadToNested(\$props);
  307. last unless defined $val;
  308. $val = UnescapeRTF($et, $val, $charset);
  309. if ($t eq 'propname') {
  310. $tag = $val;
  311. next;
  312. } elsif ($t ne 'staticval' or not defined $tag) {
  313. next; # ignore \linkval and \proptype for now
  314. }
  315. $tag =~ s/\s(.)/\U$1/g; # capitalize all words in tag name
  316. $tag =~ tr/-_a-zA-Z0-9//dc; # remove illegal characters
  317. next unless $tag;
  318. # create tagInfo for unknown tags
  319. unless ($$tagTablePtr{$tag}) {
  320. AddTagToTable($tagTablePtr, $tag, { Name => $tag });
  321. }
  322. $et->HandleTag($tagTablePtr, $tag, $val);
  323. }
  324. last; # (didn't really want to loop)
  325. }
  326. return 1;
  327. }
  328. 1; # end
  329. __END__
  330. =head1 NAME
  331. Image::ExifTool::RTF - Read Rich Text Format meta information
  332. =head1 SYNOPSIS
  333. This module is used by Image::ExifTool
  334. =head1 DESCRIPTION
  335. This module contains definitions required by Image::ExifTool to read meta
  336. information from RTF (Rich Text Format) documents.
  337. =head1 AUTHOR
  338. Copyright 2003-2016, Phil Harvey (phil at owl.phy.queensu.ca)
  339. This library is free software; you can redistribute it and/or modify it
  340. under the same terms as Perl itself.
  341. =head1 REFERENCES
  342. =over 4
  343. =item L<http://download.microsoft.com/download/2/f/5/2f599e18-07ee-4ec5-a1e7-f4e6a9423592/Word2007RTFSpec9.doc>
  344. =item L<http://search.cpan.org/dist/RTF-Writer/lib/RTF/Cookbook.pod>
  345. =back
  346. =head1 SEE ALSO
  347. L<Image::ExifTool::TagNames/RTF Tags>,
  348. L<Image::ExifTool(3pm)|Image::ExifTool>
  349. =cut