用net::pop3写邮件客户端，取得的邮件主题等显示乱码？

zhouyj1982

如题，想用net::pop3模块写一个邮件客户端，在取得邮箱中的邮件时，用Mail::Header解析头，输出邮件主题、发件人时，有的显示正常，有的却是乱码，请指教！
代码如下： my $msg     = $pop->;get($msgnum);
         my $parsehead  = Mail::Header->;new($msg);
         chomp (my $subject= $parsehead->;get('Subject'));
         chomp (my $from   = $parsehead->;get('From') );
         chomp (my $date   = $parsehead->;get('Date') );
         my $len = $pop->;list($msgnum) ;
是看的《perl网络编程》的第8章，
显示出的主题有一个是：
=?gb2312?B?s8/R+8T6ss68086iyO0gTVNETiBXZWJj?= =?gb2312?B?YXN0cyDW0M7EzfjC57njsqU21MIxyNW/zrPM?=

雨中漫步

关注，我也没办法解决！
我也在搞一个web mail的东西给公司自己用，但是，解码搞不好

y6cmE

呵呵，好像我这样做并无问题。

1. 
   
2. sub subject_a{
   
3.         my @ten=split("\t",$array[9]);
   
4.         my $subject_a=$ten[0];
   
5.         my $c10=substr($subject_a,0,1) eq '#'?0:1;
   
6.         if($c10){
   
7.                 print "您选择了“邮件主题精确匹配”，正在进行过滤.";
   
8.                 print LOG "您选择了“邮件主题精确匹配”，正在进行过滤.";
   
9.                 if(-z $subject_a){
   
10.                         print "文件$subject_a为空，跳过此参数\n";
    
11.                         print LOG "文件$subject_a为空，跳过此参数\n";
    
12.                        
    
13.                 }
    
14.                 else{
    
15.                         foreach my $ag (@delete){
    
16.                                 my $header=$pop->;top($ag);
    
17.                                 my $parsedhead=$parser->;parse_data($header);
    
18.                                 $parsedhead->;head->;decode;
    
19.                                 chomp(my $subject=$parsedhead->;head->;get('Subject'));
    
20.                                 unless(open(SUBJECT_A,$subject_a)){
    
21.                                         print "无法打开$subject_a，程序被中断。\n";
    
22.                                         print LOG "无法打开$subject_a，程序被中断。\n";
    
23.                                         close LOG;
    
24.                                         $pop->;quit;
    
25.                                         $parsedhead->;purge;
    
26.                                         exit;
    
27.                                 }
    
28.                                 while(<SUBJECT_A>;){
    
29.                                         chomp;
    
30.                                         print ".";
    
31.                                         print LOG ".";
    
32.                                         if($subject eq $_){
    
33.                                                 push(@del,$ag);
    
34.                                                 last;
    
35.                                         }
    
36.                                 }
    
37.                                 close SUBJECT_A;
    
38.                                 $parsedhead->;purge;
    
39.                         }
    
40.                         foreach my $this (@delete){
    
41.                                 map{$this=~s/$_//;} @del;
    
42.                         }
    
43.                         foreach my $that (@delete){
    
44.                                 if($that){
    
45.                                         push(@vov,$that);
    
46.                                 }
    
47.                         }
    
48.                         @delete=@vov;
    
49.                         @vov=();
    
50.                         @del=();
    
51.                         print ".完成。\n";
    
52.                         print LOG ".完成。\n";
    
53.                 }
    
54.         }
    
55.         else{
    
56.                 print "您未选择“邮件主题精确匹配”，跳过此参数。\n";
    
57.                 print LOG "您未选择“邮件主题精确匹配”，跳过此参数。\n";
    
58.         }
    
59. }
    
60. 
    

复制代码

zhouyj1982

自己再琢磨琢磨。
y6cmE，你从pop3服务器取邮件时的代码能贴出来看看吗？

navysniper

需要解码

y6cmE

1. 
   
2. #!e:/perl/bin/perl.exe -w
   
3. use strict;
   
4. ###        0.0.8.2                2003.6.8      by y6cmE
   
5. use Net::POP3;
   
6. use MIME::Parser;
   
7. use Term::ReadKey;
   
8. ######################################################################################
   
9. local $|=1;
   
10. my $host;
    
11. my $user;
    
12. my @array;
    
13. my @delete;
    
14. my @del;
    
15. my @vov;
    
16. my $pop;
    
17. my $messages;
    
18. my $parser;
    
19. my $localtime=localtime;
    
20. unless(open(LOG,">;log.txt")){
    
21.         print "无法写日志文件log.txt！程序中断。\n";
    
22.         exit;
    
23. }
    
24. print "$localtime\n";
    
25. print LOG "$localtime\n";
    
26. if($#ARGV == 1){
    
27.         $host=shift;
    
28.         $user=shift;
    
29.         &
    
30. }
    
31. elsif(-e "getopt.ini"){
    
32.         unless(open(GETOPT,"getopt.ini")){
    
33.                 print "无法打开getopt.ini读取服务器与用户名，程序中断。\n";
    
34.                 print LOG "无法打开getopt.ini读取服务器与用户名，程序中断。\n";
    
35.                 close LOG;
    
36.                 exit;
    
37.         }
    
38.         my @get=<GETOPT>;;
    
39.         close GETOPT;
    
40.         my $gtt=join("",@get);
    
41.         my @opt=split("\n",$gtt);
    
42.         $host=$opt[0];
    
43.         $user=$opt[1];
    
44.         &
    
45. }
    
46. else{
    
47.         print "您的使用方法错误，请先阅读“readme”。^_^\n";
    
48.         print LOG "您的使用方法错误，请先阅读“readme”。^_^\n";
    
49.         close LOG;
    
50. }
    
51. ######################################################################################
    
52. sub hack{
    
53.         unless(open(CONFIG,"config.ini")){
    
54.                 print "无法打开config.ini，程序中断。\n";
    
55.                 print LOG "无法打开config.ini，程序中断。\n";
    
56.                 close LOG;
    
57.                 exit;
    
58.         }
    
59.         my $foo;
    
60.         while(<CONFIG>;){
    
61.                 $foo.=$_;
    
62.         }
    
63.         close CONFIG;
    
64.         @array=split("\n",$foo);
    
65.         my @one=split("\t",$array[0]);
    
66.         my $port=$one[0];
    
67.         my @two=split("\t",$array[1]);
    
68.         my $timeout=$two[0];
    
69.         unless($pop=Net::POP3->;new($host,Port=>;$port,Timeout=>;$timeout)){
    
70.                 print "无法连接$host或连接时间超过$timeout秒，请检查是否已上网、服务器地址是否正确。\n";
    
71.                 print LOG "无法连接$host或连接时间超过$timeout秒，请检查是否已上网、服务器地址是否正确。\n";
    
72.                 close LOG;
    
73.                 exit;
    
74.         }
    
75.         print "请输入您的密码（不回显）：";
    
76.         ReadMode("noecho");
    
77.         chomp(my $pass=<STDIN>;);
    
78.         ReadMode(0);
    
79.         unless($messages=$pop->;login($user,$pass)){
    
80.                 print "\n无法登录$host的$user，请检查用户名与密码是否正确。\n";
    
81.                 print LOG "\n无法登录$host的$user，请检查用户名与密码是否正确。\n";
    
82.                 close LOG;
    
83.                 exit;
    
84.         }
    
85.         print "\n登录到$host的$user\n";
    
86.         print LOG "登录到$host的$user\n";
    
87.         my @three=split("\t",$array[2]);
    
88.         my $offhand=$three[0];
    
89.         $parser=new MIME::Parser;
    
90.         unless(-d $offhand){
    
91.                 unless(mkdir($offhand,0777)){
    
92.                         print "无法创建目录$offhand，程序中断。\n";
    
93.                         print LOG "无法创建目录$offhand，程序中断。\n";
    
94.                         close LOG;
    
95.                         $pop->;quit;
    
96.                         exit;
    
97.                 }
    
98.         }
    
99.         unless($parser->;output_dir("$offhand")){
    
100.                 print "打不开目录$offhand，程序中断。\n";
     
101.                 print LOG "打不开目录$offhand，程序中断。\n";
     
102.                 close LOG;
     
103.                 $pop->;quit;
     
104.                 exit;
     
105.         }
     
106.         $parser->;output_prefix("pgg");
     
107.         if($messages eq "0E0"){
     
108.                 print "您的邮箱没有邮件，程序结束，谢谢使用！\n";
     
109.                 print LOG "您的邮箱没有邮件，程序结束，谢谢使用！\n";
     
110.                 close LOG;
     
111.                 $pop->;quit;
     
112.                 exit;
     
113.         }
     
114.         else{
     
115.                 print "您的邮箱共有$messages封信件。\n";
     
116.                 print LOG "您的邮箱共有$messages封信件。\n";
     
117.                 my $last=$pop->;last;
     
118.                 $last+=1;
     
119.                 $messages+=0;
     
120.                 foreach my $msgnum ($last..$messages){
     
121.                         push(@delete,$msgnum);
     
122.                 }
     
123.                 &
     
124.                 &
     
125.                 &
     
126.                 &from_m;
     
127.                 &from_a;
     
128.                 &subject_m;
     
129.                 &subject_a;
     
130.                 &filename_m;
     
131.                 &body_a;
     
132.                 &body_m;
     
133.                 &
     
134. ......
     

复制代码

zhouyj1982

谢谢y6cmE，
前面都类似，就是在解析邮件时，你用MIME:arser模块解析，解析出来的主题等都显示正常吗？
看起来用MIME:arser还挺麻烦的

zhouyj1982

《perl网络编程》中的一段代码，
#!c:\perl\bin\perl

use strict;
use Net:OP3;
use MIME::Entity;
use MIME:arser;

my $file = 'D:\example\11.txt';
open F,$file or die "can't open $file!\n";   
   
my $pop = Net:OP3->;new($host) or die "Can't connect to $host!\n";
my $message = $pop->;login($user=>;$passwd) or die "Can't log in:",$pop->;message,"\n";
my $last = $pop->;last;
$message +=0;
print "inbox has $message message(",$message-$last,"new)\n";

my $parser =new MIME:arser;
$parser->;output_dir("d:\\mail";

my $entity = $parser->;parse(\*F);

print "From        = ",$entity->;head->;get('From'),"\n";
print "Subject     = ",$entity->;head->;get('Subject'),"\n";
print "MIME type   = ",$entity->;mime_type,"\n";
print "arts       = ",scalar $entity->;parts,"\n";

for my $part ($entity->;parts) {
        print "\t",$part->;mime_type,"\t",$part->;bodyhandle->;path,"\n";
}

$entity->;purge;

想试试用MIME:arser对mail头进行解析是怎样，但是解析出来的除了MIME type都是空，这是为什么？
执行一次，在d:\\mail下会有一个空的文本文件，是不是因为my $file = 'D:\example\11.txt'中的11.txt的问题？书上说应该是一个包含MIME编码的消息。但是我不知道这个文件应该是怎样的。
请教大家！

雨中漫步

再关注MIME:arser，不知它的解码效果，针对于不同的编码方式，如GBK，UTF-8，等，还有用outlook发送word文件的特殊编码方式，解码效果如何？
这些问题，搞得我头疼!

hoowa

使用MIME::Head的decode方法可以解码。