Here's the code:
#!/usr/bin/perl -w
use MIME::Parser;
use DBI;
use strict;
my $database = "xxxxxxx";
my $dbuser = "xxxxxxx";
my $dbpasswd = "xxxxxxx";
my $outputdir = "/some/directory";
my $parser = new MIME::Parser;
$parser->output_dir($outputdir);
$parser->output_prefix("attachment");
$parser->output_to_core();
my $entity = $parser->read(\*STDIN);
my $msg_header = $entity->stringify_header;
my $num_parts = $entity->parts;
my $msg_body;
if ($num_parts > 0) {
for (my $i = 0; $i < $num_parts; $i++) {
my $part = $entity->parts($i);
my $type = $part->mime_type;
my $bh = $part->bodyhandle;
if ($type =~ m/text/) {
if (my $io = $part->open("r")) {
while (defined($_ = $io->getline)) {
$msg_body .= $_;
}
$msg_body .= "\n\n";
$io->close;
}
my $status = system("rm '$bh->{MB_Path}'");
die $! unless $status == 0;
} else {
my $file = $bh->{MB_Path};
my $oldfile = $file;
$file =~ s/$outputdir\///;
my $now = time();
$file = $now . "-" . $file;
my $newfile = $outputdir . "/" . $file;
my $status = system("mv '$oldfile' '$newfile'");
die $! unless $status == 0;
$file = "some/directory" . $file;
$file = "http://url/" . $file;
$msg_body .= "ATTACHMENT: $file\n";
}
}
} else {
if (my $io = $entity->open("r")) {
while (defined($_ = $io->getline)) {
$msg_body .= $_;
}
$msg_body .= "\n";
$io->close;
}
$entity->purge;
}
### The rest is just database processing ...
The problem is that the parser dies on some mails when it should remove those temporary files.
(I know this is dirty code, but I made it most out of trial-and-error.)