switch to compatibility level 12

[debbugs.git] / Debbugs / MIME.pm

diff --git a/Debbugs/MIME.pm b/Debbugs/MIME.pm
index afc077649939784e4cedf95a81d7b75efb04ded8..fec3b6e2dc4e1dd43d8d31c020c27343407d0e30 100644 (file)
--- a/Debbugs/MIME.pm
+++ b/Debbugs/MIME.pm
@@ -10,6 +10,8 @@
 
 package Debbugs::MIME;
 
+=encoding utf8
+
 =head1 NAME
 
 Debbugs::MIME -- Mime handling routines for debbugs
@@ -30,7 +32,7 @@ None known.
 use warnings;
 use strict;
 
-use base qw(Exporter);
+use Exporter qw(import);
 use vars qw($DEBUG $VERSION @EXPORT_OK %EXPORT_TAGS @EXPORT);
 
 BEGIN {
@@ -39,7 +41,9 @@ BEGIN {
 
     @EXPORT = ();
 
-    %EXPORT_TAGS = (mime => [qw(parse create_mime_message getmailbody)],
+    %EXPORT_TAGS = (mime => [qw(parse create_mime_message getmailbody),
+                            qw(parse_to_mime_entity),
+                           ],
                    rfc1522 => [qw(decode_rfc1522 encode_rfc1522)],
                   );
     @EXPORT_OK=();
@@ -47,12 +51,12 @@ BEGIN {
     $EXPORT_TAGS{all} = [@EXPORT_OK];
 }
 
-use File::Path;
-use File::Temp qw();
+use File::Path qw(remove_tree);
+use File::Temp qw(tempdir);
 use MIME::Parser;
 
 use POSIX qw(strftime);
-use List::MoreUtils qw(apply);
+use List::AllUtils qw(apply);
 
 # for convert_to_utf8
 use Debbugs::UTF8 qw(convert_to_utf8);
@@ -86,13 +90,50 @@ sub getmailbody
     return undef;
 }
 
+=head2 parse_to_mime_entity
+
+     $entity = parse_to_mime_entity($record);
+
+Returns a MIME::Entity from a record (from Debbugs::Log), a filehandle, or a
+scalar mail message. Will die upon failure.
+
+Intermediate parsing results will be output under a temporary directory which
+should be cleaned up upon process exit.
+
+=cut
+
+sub parse_to_mime_entity {
+    my ($record) = @_;
+    my $parser = MIME::Parser->new();
+    my $entity;
+    # this will be cleaned up once we exit
+    my $tempdir = File::Temp->newdir();
+    $parser->output_dir($tempdir->dirname());
+    if (ref($record) eq 'HASH') {
+       if ($record->{inner_file}) {
+           $entity = $parser->parse($record->{fh}) or
+               die "Unable to parse entity";
+       } else {
+           $entity = $parser->parse_data($record->{text}) or
+               die "Unable to parse entity";
+       }
+    } elsif (ref($record)) {
+       $entity = $parser->parse($record) or
+           die "Unable to parse entity";
+    } else {
+       $entity = $parser->parse_data($record) or
+           die "Unable to parse entity";
+    }
+    return $entity;
+}
+
 sub parse
 {
     # header and decoded body respectively
     my (@headerlines, @bodylines);
 
     my $parser = MIME::Parser->new();
-    my $tempdir = File::Temp::tempdir();
+    my $tempdir = tempdir(CLEANUP => 1);
     $parser->output_under($tempdir);
     my $entity = eval { $parser->parse_data($_[0]) };
 
@@ -133,7 +174,7 @@ sub parse
        @bodylines = map {convert_to_utf8($_,$charset)} @msg[$i .. $#msg];
     }
 
-    rmtree $tempdir, 0, 1;
+    remove_tree($tempdir,{verbose => 0, safe => 1});
 
     # Remove blank lines.
     shift @bodylines while @bodylines and $bodylines[0] !~ /\S/;
@@ -191,7 +232,7 @@ sub create_mime_message{
      die "The third argument to create_mime_message must be an arrayref" unless ref($attachments) eq 'ARRAY';
 
      if ($include_date) {
-        my %headers = apply {lc($_)} @{$headers};
+        my %headers = apply {defined $_ ? lc($_) : ''} @{$headers};
         if (not exists $headers{date}) {
             push @{$headers},
                 ('Date',
@@ -204,7 +245,7 @@ sub create_mime_message{
      # MIME::Entity is stupid, and doesn't rfc1522 encode its headers, so we do it for it.
      my $msg = MIME::Entity->build('Content-Type' => 'text/plain; charset=utf-8',
                                   'Encoding'     => 'quoted-printable',
-                                  (map{encode_rfc1522(encode_utf8($_))} @{$headers}),
+                                  (map{encode_rfc1522(encode_utf8(defined $_ ? $_:''))} @{$headers}),
                                   Data    => encode_utf8($body),
                                  );