Viewing file:  unpack.pl (2.03 KB) -rw-r--r--
Select action/file-type:
 (+) |  (+) |  (+) | Code (+) | Session (+) |  (+) | SDB (+) |  (+) |  (+) |  (+) |  (+) |  (+) |
#!/usr/bin/perl
#
# Read a message from stdin, for instance from a '.forward' file
# | unpack.pl
# The files get unpacked.
# This code can be used and modified without restriction.
# Mark Overmeer, <mailbox@overmeer.net>, 29 jan 2010
use warnings;
use strict;
use Errno 'EEXIST';
use POSIX 'strftime';
use Mail::Message ();
use MIME::Types ();
### configure this:
my $workdir = '/tmp/incoming';
# create the common work directory
-d $workdir
or mkdir $workdir
or die "cannot create unpack directory $workdir: $!\n";
# Create a unique unpack directory for this message
# More than one message can arrive in a second, even in parallel
my $unpackdir;
my $now = strftime "%Y%m%d-%T", localtime;
UNIQUE:
for(my $unique = 1; ; $unique++ )
{ $unpackdir = "$workdir/$now-$unique";
mkdir $unpackdir and last;
$!==EEXIST
or die "cannot create unpack directory $unpackdir: $!";
}
# Read the message from STDIN
my $from_line = <>; # usually added by the local MTA
my $msg = Mail::Message->read(\*STDIN);
# Shows message structure
# $msg->printStructure;
my $mime_types = MIME::Types->new;
my $partnr = '00';
foreach my $part ($msg->parts('RECURSE'))
{ my $body = $part->decoded;
my $type = $mime_types->type($body->mimeType);
# some message parts will contain a filename
my $dispfn = $body->dispositionFilename || '';
my $partname = $partnr++ . (length $dispfn ? ".$dispfn" : '');
# try to find a nice filename extension if not yet known
unless($partname =~ /\.\w{3,5}$/)
{ my $ext = $type ? ($type->extensions)[0] : undef;
$partname .= ".$ext" if $ext;
}
my $filename = "$unpackdir/$partname";
#print "$filename\n";
if($type->isBinary)
{ open OUT, '>:raw', $filename
or die "cannot create binary part file $filename: $!";
}
else
{ open OUT, '>:encoding(utf-8)', $filename
or die "cannot create text part file $filename: $!";
}
$body->print(\*OUT);
close OUT
or warn "write errors to $filename: $!";
}
|