Beefy Boxes and Bandwidth Generously Provided by pair Networks
We don't bite newbies here... much
 
PerlMonks  

mail attachment extraction

by phocean (Novice)
on May 03, 2007 at 13:04 UTC ( [id://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 = '192.168.1.116'; 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?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: perlquestion [id://613374]
Approved by Corion
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others about the Monastery: (5)
As of 2024-03-28 16:20 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found