On Mon, 6 Sep 2004, Vincent Gulinao wrote:
> I need to create a setup that extracts MIME contents, dump them to
> directories (classified per content-type), then pass control to
> another application.
You can use MIME::Parser of perl. Sample program below. To test:
cat <mailfile> | ./mailparser.pl
or you can pipe from an alias known to your mta. The output goes to a
directory /tmp/msgN. Limitation: can process one mailfile at a time only.
rowel
############mailparser.pl#########################
#!/usr/bin/perl -w
use strict;
use MIME::Parser;
my $mailDir = "/tmp/";
#variable stuff os dependent
my $mkdir = "/bin/mkdir";
my $rm = "/bin/rm";
my $messageDir = "";
sub make_msg {
my $Msgno = 0;
my $msgDir = "";
do{
$msgDir = "$mailDir"."msg$Msgno";
++$Msgno;
}while (-d $msgDir);
`$mkdir -m 0755 $msgDir`; # or die "couldn't make $msgDir: $!";
"$msgDir";
}
#------------------------------------------------------------
# dump_entity - dump an entity's file info
#------------------------------------------------------------
sub dump_entity {
my $ent = shift;
my @parts = $ent->parts;
if (@parts) { # multipart...
map { dump_entity($_) } @parts;
}
else { # single part...
print "Attachment: ",$ent->bodyhandle->path,"\n";
print "MIME Type: ",scalar($ent->head->mime_type),"\n";
print "MIME Encoding: ",scalar($ent->head->mime_encoding),"\n";
}
}
sub parseEmail{
# Go through the message:
$messageDir = make_msg();
print "Message dir: ",$messageDir,"\n";
# Create a new parser object:
my $parser = new MIME::Parser;
$parser->output_dir($messageDir);
# Parse an input stream:
my $entity;
$entity = $parser->read(\*STDIN) or
print STDERR "Couldn't parse MIME in STDIN. continuing...\n";
print "Sender: ",$entity->head->get('From');
print "Subject: ",$entity->head->get('Subject');
dump_entity($entity) if $entity;
return 0;
}
sub cleanUp(){
`$rm -rf $messageDir`;
return 0;
}
die if(parseEmail());
#die if(cleanUp());
--
Philippine Linux Users' Group (PLUG) Mailing List
[EMAIL PROTECTED] (#PLUG @ irc.free.net.ph)
Official Website: http://plug.linux.org.ph
Searchable Archives: http://marc.free.net.ph
.
To leave, go to http://lists.q-linux.com/mailman/listinfo/plug
.
Are you a Linux newbie? To join the newbie list, go to
http://lists.q-linux.com/mailman/listinfo/ph-linux-newbie
