#!/usr/bin/env perl
#
use strict;
use warnings;
use Data::Dumper;
use File::Slurp qw( read_file );
use Email::Address;
use Email::MIME::Attachment::Stripper;
use File::Slurp qw(slurp write_file);
my $infile = '/home/*****/Mail/.family.directory/1277709595.16641.pRLSb:2,S';
my $outfile = 'output4.txt';
my $intext = File::Slurp::read_file( $infile );
my $parser = Email::MIME->new($intext);
my @parts = $parser->parts;
my $stripper = Email::MIME::Attachment::Stripper->new($parser);
my $message = $stripper->message;
print $message;
foreach my $attachment ( $stripper->attachments ) {
write_file( $attachment->{filename},
{ buf_ref => \$attachment->{payload} } )
or die "Can't write $attachment->{filename}: $!\n";
}Email::MIME=HASH(0x1c3a418)Email::MIME=HASH(0x1d24cb8)
#!/usr/bin/perl
#
# Name: multipart-mo.pl
#
# Extract names and email addresses from a maildir folder
#
# - Also displays the number of messages (files) found and the number of parts in each message
# - Displays structure of each message and then outputs the names and email addresses
# - Where the name/email address is found in the 'body' part of a message (i.e NOT in From:, To:, Cc: etc,etc),
# then usually only the email address will be returmed
#
# This script has been adapted from multipart.pl , which is part of the Mail::Box module , vers 2.118,
# by Mark Overmeer (http://http://search.cpan.org/dist/Mail-Box/ )
#
# This code can be used and modified without restriction.
#
# Usage: perl multipart-mo.pl Smith\,\ Bill\ \&\ Nancy/ (maildir folder name)
#
use warnings;
use strict;
use lib '..', '.';
use Mail::Box::Manager;
sub emails_from_body($);
#
# Get the command line arguments.
#
die "Usage: $0 folderfile\n"
unless @ARGV==1;
my $foldername = shift @ARGV;
#
# Open the folder
#
my $mgr = Mail::Box::Manager->new;
my $folder = $mgr->open($foldername, access => 'r')
or die "Cannot open $foldername: $!\n";
#
# List all messages in this folder.
#
print "Mail folder $foldername contains ", $folder->nrMessages, " messages:\n";
my %emails;
foreach my $message ($folder->messages)
{
my @parts = ($message, $message->parts('RECURSE'));
print $message->seqnr, ' has '.@parts." parts\n";
$message->printStructure;
foreach my $part (@parts)
{
foreach my $fieldname (qw/To Cc Bcc From Reply-To Sender/)
{ my $field = $part->study($fieldname) or next;
$emails{$_}++ for $field->addresses;
}
my $ct = $part->contentType || 'text/plain';
$ct eq 'text/plain' || $ct eq 'text/html' or next;
$emails{$_}++ for emails_from_body $part->body->decoded;
}
}
print "$_\n" for sort keys %emails;
$folder->close;
exit 0;
### HELPERS
sub emails_from_body($)
{
$_[0] =~ /([-\w.]+@([a-z0-9][a-z-0-9]+\.)+[a-z]{2,})/gi;
}
