Perl如何解析MS Exchange Sever的MIME格式邮件

aaronluo

小弟最近在学习写一个邮件接收程序，因为讨厌outlook占用太多内存，所以想用Perl写一个文本模式下可以浏览邮件的小程序，下面是我的写的代码，目前可以列出、删除邮件，但是对于邮件的具体内容读取在郁闷中，有经验的xdjm来出出主意。我试过很多MIME格式文件解析的package，都没有成功。我知道一个MIME格式的邮件可能包含附件或者图片等复杂的内容，暂时我不考虑，目前只考虑读取文本部分，以后我再完善这个程序。

#/usr/local/perl/bin
use warnings;
use strict;
use Mail::IMAPClient;
use Mail::IMAPClient::BodyStructure;


my $inbox = "INBOX";
my $flag = 1;
#read mail.ini file for mail account info
my $ini_file = "mail.ini";
#my $ini_file = "sina.ini";
print "Loading ini file....";
my @res = &load_ini_file($ini_file);

my $host = $res[0];
my $user = $res[1];
my $pass = $res[2];            
my $port = $res[3];                                                #for imap.gmail.com                  
print "Finished!\n";
print "Host=$host, User=$user\n";
#try to connect to IMAP server
my $connect = Mail::IMAPClient->new(
                                Server => $host,
                                User => $user,
                                Password => $pass,
                                Port => $port
) or die "Cannot connect to $host as $user: $@\n";

#input cmd to operate the inbox(list, read, delte, help, quit)
print "To do?\n>";
while( $flag == 1 &&( my $cmd = <STDIN> )) {
        chomp $cmd;
        
        if ( $cmd =~ /quit/i ){
                &close_mailbox;
        }elsif ( $cmd =~ /help/i ){
                &print_help;
        }elsif ( $cmd =~ /list/i ){
                &print_messages;
        }elsif ( $cmd =~ /^read\s*\d*$/i ){
                &read_messages($cmd);
        }elsif ( $cmd =~ /^delete\s*\d*$/i ){
                &delete_message($cmd);
        }else{
                print "You input wrong command.\n";
                &print_help;
        }
        
        print ">";
}
################subroutine#####################
sub delete_message{
        my $cmd = shift @_;
        
        $cmd =~ s/\s+/=/g;
        my @tmp = split( /=/, $cmd);
        
        if ( @tmp == 1) {
                print "You should input msg id to delete it.\n";
        }elsif( @tmp == 2) {
                my $msg_id = $tmp[1];
                print "Message[$msg_id]: delete?(Y/N)";
                my $b = <STDIN>;
                if($b =~ /[Y,y,yes]/){
                        if( $connect->delete_message($msg_id) ){
                                # 'delete_message' only marks *DELETE* flag to the message,
                                # it should be effective after invoking 'expugne'.
                                $connect->expunge();
                                print "delete message [$msg_id].\n";
                        }
                }        
        }
}

sub read_mail_content{
        my $msg_id = shift @_;
}

sub read_messages{
        my $cmd = shift @_;
        
        $cmd =~ s/\s+/=/g;
        my @tmp = split( /=/, $cmd);
        
        
        if ( @tmp == 1) {
#                my @msgs = $connect->messages;
                my @msgs = $connect->search("ALL");
                for my $msg_id (@msgs) {
                        &read_messages("read $msg_id");
                }
        }elsif( @tmp == 2) {
                my $msg_id = $tmp[1];
                print "Message[$msg_id]:\n";
                if( 1 == &print_message($msg_id) ){
                        &read_mail_content($msg_id);
                }        
        }
}

sub print_messages{
        $connect->select($inbox) or die "Cannot select $inbox: $@\n";        
        my $message_count = $connect->message_count;
        print "There are $message_count messages in your inbox.\n";
        
#        my @msgs = $connect->messages;
        my @msgs = $connect->search("ALL");
        my $count = 1;
        foreach my $msg_id (@msgs) {
                &print_message($msg_id, ($count++));
        }
}

sub print_message{
        my ($msg_id, $count) = @_;
        
        my $data = $connect->parse_headers($msg_id, "From", "Subject", "Date");
        if(!$data){
                print "There isn't message which id is $msg_id, please use 'list' to check it.\n";
                return 0;
        }else{
                my $subject = defined($data->{Subject}->[0]) ? $data->{Subject}->[0] : 'no subject';
                my $from = $data->{From}->[0];
                my $date = $data->{Date}->[0];
                printf "%2d.\t$msg_id\t$subject\t$from\t$date\n", $count if ($count);
                printf "$msg_id\t$subject\t$from\t$date\n" if (!$count);
                return 1;
        }
}

sub print_help{
        print "Usage: <cmd> [args]\n";
        print "there are commands:\n";
        print "\tlist: To list all messages in inbox.\n";
        print "\tread: To read one message in inbox. It must be with message id as arguments.\n";
        print "\tdelete: To delete the message in inbox. It should be with message id as arguments.\n";
        print "\t        If there's no args, it will delete all messages in inbox\n";
        print "\thelp: To show this document.\n";
        print "\tquit: To quit this programme.\n";
}

sub close_mailbox{
        if ( $connect->IsSelected($inbox)){
                $connect->close or die "Cannot close: $@\n";
        }
        $connect->logout();
        print "\nBye.\n";
        $flag = 0;
}


sub load_ini_file {
        my $ini_file = shift @_;
        
        if ( -e $ini_file ) {
                open( INIFILE, $ini_file ) or die "Can't open ini file!";
               

               
                my @lines = <INIFILE>;
               
                foreach my $line (@lines) {
                        chomp $line;
                        my @tmp = split( /=/, $line );
                        if ( @tmp == 2 ) {
                                $line = $tmp[1];
                        }
                }
               
                return @lines;
        }
        else {
                die "There's no ini file exsits!";
        }

}

churchmice

search CPAN

ulmer

Using CPAN module "MIME::Parser" to process the mail body and
fetch the text body only!

good luck!