xapian-applications/omega/outlookmsg2html.in

   1 #!@PERL@
   2 # @configure_input@
   3 # @file outlookmsg2html
   4 # @brief Extract text from an outlook .msg or .oft file.
   5 #
   6 # Copyright (C) 2010,2015 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 };
  31 if ($@) {
  32     print STDERR $@;
  33     # Exit with code 127 which omindex interprets as "filter not installed"
  34     # and won't try further .msg files.
  35     exit 127;
  36 }
  37
  38 handle_mimepart(new Email::Outlook::Message($ARGV[0])->to_email_mime);
  39
  40 sub handle_mimepart {
  41     my $e = shift;
  42     my ($type, $sub) = ((lc $e->content_type) =~ m,^(.*?)/(.*?)(?:;.*)?$,);
  43     if ($type eq 'multipart') {
  44         if ($sub eq 'alternative') {
  45             # Take the first mime part which we get text from.
  46             for my $s ($e->subparts) {
  47                 my $res = handle_mimepart($s);
  48                 return $res if $res;
  49             }
  50         } else {
  51             my $res = 0;
  52             for my $s ($e->subparts) {
  53                 $res += handle_mimepart($s);
  54             }
  55             return $res;
  56         }
  57     } elsif ($type eq 'text') {
  58         if ($sub eq 'plain') {
  59             print "<pre>", HTML::Entities::encode_entities($e->body), "</pre>\n";
  60             return 1;
  61         } elsif ($sub eq 'html') {
  62             my $m = $e->body;
  63             $m =~ s!</?body[^>]*>!\n!gi;
  64             print $m, "\n";
  65             return 1;
  66         }
  67     } elsif ($type eq 'message' && $sub eq 'rfc822') {
  68         return handle_mimepart(Email::MIME->new($e->body));
  69     }
  70     return 0;
  71 }