xapian-applications/omega/outlookmsg2html.in

   1 #!@PERL@
   2 # @configure_input@
   3 # @file
   4 # @brief Extract text from an outlook .msg or .oft file.
   5 #
   6 # Copyright (C) 2010,2015,2019,2023 Olly Betts
   7 #
   8 # Permission is hereby granted, free of charge, to any person obtaining a copy
   9 # of this software and associated documentation files (the "Software"), to
  10 # deal in the Software without restriction, including without limitation the
  11 # rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
  12 # sell copies of the Software, and to permit persons to whom the Software is
  13 # furnished to do so, subject to the following conditions:
  14 #
  15 # The above copyright notice and this permission notice shall be included in
  16 # all copies or substantial portions of the Software.
  17 #
  18 # THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
  19 # IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
  20 # FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
  21 # AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
  22 # LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
  23 # FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
  24 # IN THE SOFTWARE.
  25
  26 use strict;
  27 eval {
  28     require Email::Outlook::Message;
  29     require HTML::Entities;
  30     # In core since Perl 5.9.5:
  31     require Time::Piece;
  32 };
  33 if ($@) {
  34     print STDERR $@;
  35     # Exit with code 127 which omindex interprets as "filter not installed"
  36     # and won't try further .msg files.
  37     exit 127;
  38 }
  39
  40 my $mime = new Email::Outlook::Message($ARGV[0])->to_email_mime;
  41 print "<head>\n<title>";
  42 print do_header($mime, 'Subject');
  43 print "</title>\n<meta name=\"author\" content=\"";
  44 print do_header($mime, 'From');
  45 print "\">\n";
  46
  47 my $date = do_header($mime, 'Date');
  48 chomp $date;
  49 eval {
  50     eval {
  51         $date = Time::Piece->strptime($date, '%a, %d %b %Y %T %z');
  52     };
  53     # The "%a, " part is optional in RFC822 and RFC2822.
  54     $date = Time::Piece->strptime($date, '%d %b %Y %T %z') if $@;
  55     my $iso8601_date = $date->datetime;
  56     print "<meta name=\"created\" content=\"$iso8601_date\">\n";
  57 };
  58
  59 print "</head>\n";
  60
  61 handle_mimepart($mime);
  62
  63 sub do_header {
  64     my ($msg, $header) = @_;
  65     my $s = $msg->header_str($header);
  66     return HTML::Entities::encode_entities($s);
  67 }
  68
  69 sub handle_mimepart {
  70     my $e = shift;
  71     my ($type, $sub) = ((lc $e->content_type) =~ m,^(.*?)/(.*?)(?:;.*)?$,);
  72     if ($type eq 'multipart') {
  73         if ($sub eq 'alternative') {
  74             # Take the last mime part which we get text from.
  75             for my $s (reverse $e->subparts) {
  76                 my $res = handle_mimepart($s);
  77                 return $res if $res;
  78             }
  79         } else {
  80             my $res = 0;
  81             for my $s ($e->subparts) {
  82                 $res += handle_mimepart($s);
  83             }
  84             return $res;
  85         }
  86     } elsif ($type eq 'text') {
  87         if ($sub eq 'plain') {
  88             print "<pre>", HTML::Entities::encode_entities($e->body_str), "</pre>\n";
  89             return 1;
  90         } elsif ($sub eq 'html') {
  91             my $m = $e->body_str;
  92             $m =~ s!</?body[^>]*>!\n!gi;
  93             print $m, "\n";
  94             return 1;
  95         }
  96     } elsif ($type eq 'message' && $sub eq 'rfc822') {
  97         return handle_mimepart(Email::MIME->new($e->body));
  98     }
  99     return 0;
 100 }