[pmg-devel] [PATCH pmg-api 02/10] add PMG::MIMEUtils helper package

[Dominik Csapak]

this package provides some often used MIME funcionality that we use

Signed-off-by: Dominik Csapak <d.csapak at proxmox.com>
---
 src/Makefile         |  1 +
 src/PMG/MIMEUtils.pm | 76 ++++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 77 insertions(+)
 create mode 100644 src/PMG/MIMEUtils.pm

diff --git a/src/Makefile b/src/Makefile
index c864ae8..95e63c9 100644
--- a/src/Makefile
+++ b/src/Makefile
@@ -50,6 +50,7 @@ LIBSOURCES =				\
 	PMG/pmgcfg.pm			\
 	PMG/RESTEnvironment.pm		\
 	PMG/Utils.pm			\
+	PMG/MIMEUtils.pm		\
 	PMG/HTMLMail.pm			\
 	PMG/ModGroup.pm			\
 	PMG/SMTPPrinter.pm		\
diff --git a/src/PMG/MIMEUtils.pm b/src/PMG/MIMEUtils.pm
new file mode 100644
index 0000000..9c2d133
--- /dev/null
+++ b/src/PMG/MIMEUtils.pm
@@ -0,0 +1,76 @@
+package PMG::MIMEUtils;
+
+# provides helpers for dealing with MIME related code
+
+use strict;
+use warnings;
+
+use MIME::Parser;
+use File::Path;
+
+# wrapper around MIME::Parser::new which allows to give the config as hash
+sub new_mime_parser {
+    my ($params, $dump_under) = @_;
+
+    my $parser = new MIME::Parser;
+
+    $parser->extract_nested_messages($params->{nested});
+    $parser->ignore_errors($params->{ignore_errors} // 1);
+    $parser->extract_uuencode($params->{extract_uuencode});
+    $parser->decode_bodies($params->{decode_bodies})
+	if defined($params->{decode_bodies});
+    $parser->max_parts($params->{maxfiles})
+	if defined($params->{maxfiles});
+
+    my $dumpdir = $params->{dumpdir};
+    if (!$dumpdir) {
+	$parser->output_to_core(1);
+    } elsif ($dump_under) {
+	$parser->output_under($dumpdir);
+    } else {
+	rmtree $dumpdir;
+
+	# Create and set the output directory:
+	(-d $dumpdir || mkdir($dumpdir ,0755)) ||
+	die "can't create $dumpdir: $! : ERROR";
+	(-w $dumpdir) ||
+	die "can't write to directory $dumpdir: $! : ERROR";
+
+	$parser->output_dir($dumpdir);
+    }
+
+    # this has to be done after setting the dumpdir
+    $parser->filer->ignore_filename($params->{ignore_filename})
+	if defined($params->{ignore_filename});
+
+    return $parser;
+}
+
+# bug fix for content/mimeparser.txt in regression test
+sub fixup_multipart {
+    my ($entity) = @_;
+
+    if ($entity->mime_type =~ m|multipart/|i && !$entity->head->multipart_boundary) {
+	$entity->head->mime_attr('Content-type' => "application/x-unparseable-multipart");
+    }
+
+    return $entity;
+}
+
+sub traverse_mime_parts {
+    my ($entity, $subbefore, $subafter) = @_;
+
+    if (defined($subbefore)) {
+	$subbefore->($entity);
+    }
+
+    foreach my $part ($entity->parts) {
+	traverse_mime_parts($part, $subbefore, $subafter);
+    }
+
+    if (defined($subafter)) {
+	$subafter->($entity);
+    }
+}
+
+1;
-- 
2.20.1