Beefy Boxes and Bandwidth Generously Provided by pair Networks
Your skill will accomplish
what the force of many cannot

mail attachment extraction

by phocean (Novice)
on May 03, 2007 at 13:04 UTC ( #613374=perlquestion: print w/replies, xml ) Need Help??
phocean has asked for the wisdom of the Perl Monks concerning the following question:

Hi everyone ! I am trying to make a script that extract attachments from the last seen email of an imap box. I was asked to do it even though my skills in programming are poor and I just started to learn perl 2 weeks ago... However, I think I am close to it but have been blocked for days on the same problem. I can display the message and its attachment using the IMAP:Talk module. But, I couldn't transmit the message as a MIME object to the Email-Stripper module... Here is my script :
to#!/usr/bin/perl use strict; use warnings; use Data::Dumper; use Email::Simple; use Email::MIME; use Mail::IMAPTalk qw(:utf8support); use Email::MIME::Attachment::Stripper; use Mail::Message::Attachment::Stripper; #use Email::Store::Attachment; use constant DUMP => '/home/jc'; my $server = ''; my $imap_port = '143'; my $login = 'jc'; my $password = 'pass'; my $FolderName = 'INBOX'; print "******************\n"; print "* MAIL EXTRACT *\n"; print "******************\n\n"; print "Connecting to IMAP server at ".$server.":".$imap_port."...\n"; # open the imap connection using IMAP::Talk my $imap = Mail::IMAPTalk->new( Server => $server, Port => $imap_port, Username => $login, Password => $password, Separator => '.', RootFolder => 'Inbox', CaseInsensitive => 1, ParseOption => 'DecodeUTF8', ) || die "Connection failed. Reason: $@"; #$imap->parse_mode(ParseOption => 'DecodeUTF8'); # Select folder and get first unseen message $imap->select($FolderName) || die $@; my $MsgId = $imap->search('not', 'seen')->[0]; if ($MsgId) { # Get the enveloppe print "The message with ID ".$MsgId." has the following enveloppe +:\n"; my $MsgEV = $imap->fetch($MsgId, 'envelope')->{$MsgId}->{envelope} +; print "From: " . $MsgEV->{From}."\n"; print "To: " . $MsgEV->{To}."\n"; print "Subject: " . $MsgEV->{Subject}."\n"; print "Sender: " . $MsgEV->{Sender}."\n"; print "Continue ?\n"; getc(STDIN); # Get the message body structure my $MsgBS = $imap->fetch($MsgId,'bodystructure')->{$MsgId}->{bodys +tructure}; if ($MsgBS->{Size}) { print "Size of the message :".$MsgBS->{Size}."\n"; } else { my $i=0; my $size=0; while ($MsgBS->{'MIME-Subparts'}[$i]) { $size=$size+$MsgBS->{'MIME-Subparts'}[$i]->{Size}; $i++; } print "Size of the message :".$size." kB\n"; } print "Continue ?\n"; getc(STDIN); # Find imap part number of text part of message my $MsgTxtHash = Mail::IMAPTalk::find_message($MsgBS); my $MsgPart = $MsgTxtHash->{text}->{'IMAP-Partnum'}; # Retrieve message text body my $MsgTxt = $imap->fetch($MsgId, ('rfc822.size'))->{$MsgId}->{bod +y}; print "Full message : \n"; print "\n<-------------------------------------->\n"; print $MsgTxt."\n"; print "\n<-------------------------------------->\n"; print "Continue ?\n"; getc(STDIN); # Transform the content from IMAP:Talk into a MIME object using Em +ail:MIME my $parsed = Email::MIME->new($MsgTxt); print "Parsed content :\n". Dumper( $parsed) . "\n"; print "Filename :".$parsed->{filename}."\n"; print "parsed->body".$parsed->{body_raw}."\n"; # display the MIME structure print "MIME structure :" . $parsed->debug_structure . "\n"; my $parts = $parsed->parts; #print "Number of email parts : $parts\n"; my @parts = $parsed->parts; my $i=0; #foreach (@parts) { # print "Dumped email part $i:\n", # Dumper( $parts[$i] ), # "\n"; # $i++; #} #my $decoded = $parsed->body; print "body: " . Dumper( $decoded ) . "\n"; # Give the Email MIME content to Attachment::Stripper for extracti +on my $stripper; if ($parts > 1) { $stripper = Email::MIME::Attachment::Stripper->new($MsgTxt); print "stripper :".$stripper."\n"; } else { die "This message consists of a single part.\n"; } #print "Stripper :".Dumper($stripper)."\n"; die "Not an regular MIME part given to stripper:\n" if not ref $stripper; # The extraction method itself my @attach = $stripper->attachments; # Display the resulting attachments hash $i=0; foreach (@parts) { print "hash:\n" . Dumper( $attach[$i]->{payload}) . "\n"; $i++; } # Close the IMAP connection $imap->logout(); $i=0; # Save the attachments on the local disk foreach (@attach) { my $file = 'test'.$i; #DUMP . @attach->filename(1); open FILE, '>', $file or die $!; #print FILE $attach[$i]; print FILE $stripper; close FILE; chmod 0644, $file; $i++; } } else { print "No new message in the mailbox\n" }
Thanks very much in advance for those who will look at it !!!

Replies are listed 'Best First'.
Re: mail attachment extraction
by Krambambuli (Curate) on May 03, 2007 at 16:36 UTC
    There are a lot of things here that would need or could be done differently - really a bit too much of them to insist now.

    Anyway, I've tried to just a bit modify your code so that it would allow you to go ahead.

    Hope that helps.
      Thank you for your nice corrections. I now can figure out where the problem precisely is. Imap:Talk through its fetch() method returns a structure. But Email::Mime is waiting for a string... I am trying now to find a way... I have tried a method parse_mode(ParseOption => $ParseMode) given by Imap::Talk, but without success for now... Or maybe should I use a different module ?
        I guess you don't really need Email::MIME explicitely.

        Once you got the message you want in $MsgTxt, just do
        my $stripper = Email::MIME::Attachment::Stripper->new( $MsgTxt); my @attachments = $stripper->attachments;
        and you should have what you want.

Log In?

What's my password?
Create A New User
Node Status?
node history
Node Type: perlquestion [id://613374]
Approved by Corion
and all is quiet...

How do I use this? | Other CB clients
Other Users?
Others scrutinizing the Monastery: (5)
As of 2017-01-20 23:24 GMT
Find Nodes?
    Voting Booth?
    Do you watch meteor showers?

    Results (180 votes). Check out past polls.