Perl模块使用 => 简短例子代码集合！

deathcult

(20) Net:OP3, login(), list(), get()

1. 
   
2. #!/usr/bin/perl
   
3. use strict;
   
4. use Net::POP3;
   
5. use Data::Dumper;
   
6. 
   
7. my $user = "user";
   
8. my $pass = shift or die "Usage : $0 passwd\n";
   
9. my $host = "pop3.web.com";#pop3 address
   
10. 
    
11. my $p = Net::POP3->;new($host) or die "Can't connect $host!\n";
    
12. $p->;login($user, $pass) or die "user or passwd error!\n";
    
13. my $title = $p->;list or die "No mail for $user\n";
    
14. 
    
15. foreach my $h(keys %$title)
    
16. {
    
17.         my $msg = $p->;get($h);
    
18.         print @$msg;       
    
19. }
    
20. $p->;quit;
    
21. exit 0;
    

复制代码

telnet pop3.web.com 110 也可以直接连到pop3 server上，然后通过
pop3命令与邮件服务器交互，
简单的命令有：
USER name
PASS string

STAT
LIST [n]
RETR msg
DELE msg
NOOP
RSET
QUIT
有兴趣的朋友可以试一试。
这样，也就可以利用Net::Telnet来做一个收信件的简单程序。

deathcult

(21) Term::ANSIColor 例子一

1. 
   
2. #!/usr/bin/perl
   
3. use strict;
   
4. use Term::ANSIColor qw(:constants);
   
5. 
   
6. $Term::ANSIColor::AUTORESET = 1;
   
7. 
   
8. $| = 1;
   
9. my $str = "Welcome to chinaunix ^_^!\n";
   
10. 
    
11. for my $i(0..length($str)-1)
    
12. {
    
13.         print BOLD RED substr($str, $i, 1);
    
14.         select(undef, undef, undef, 0.3);
    
15. }
    
16. exit 0;
    

复制代码

   

查看ANSIColor.pm可以得知作者是利用ANSI转义序列，改变终端字符颜色的。
print "\e[34m\n";
即是改变前景色为blue;

shell命令为echo -e "\033[31m";#改变前景色为红色。
(freeBSD，Solaris下此命令测试OK)

deathcult

(21) Term::ANSIColor 例子二

1. 
   
2. #!/usr/bin/perl
   
3. use strict;
   
4. use Term::ANSIColor qw(:constants);
   
5. 
   
6. $Term::ANSIColor::AUTORESET = 1;
   
7. 
   
8. $| = 1;
   
9. 
   
10. print "\e[20;40H";
    
11. my $str = "Welcome to chinaunix ^_^!\n";
    
12. 
    
13. print BOLD BLINK $str;
    
14. exit 0;
    

复制代码

转义序列echo -e "\033[20;40H";可以改变光标位置。
perl中就可以：print "\e[20;40H";

详细请搜索精华。还有perldoc Term::ANSIColor 。

deathcult

(22) Date::Calc Calendar(), Today()

1. 
   
2. #!/usr/bin/perl
   
3. use strict;
   
4. use Date::Calc qw(Calendar Today);
   
5. 
   
6. my $year = "2003";
   
7. my $month = "6";
   
8. my $day;
   
9. 
   
10. 
    
11. my $cal = Calendar($year, $month);
    
12. (undef, undef, $day) = Today();
    
13. 
    
14. $cal =~ s/$day/\e[5m\e[31m$day\e[0m/;
    
15. 
    
16. print $cal;
    
17. exit 0;
    

复制代码

   

本例子打印出一个2003年6月份的日历，当天日期用红色的闪烁数字表示。

Date::Calc提供了时间日期计算的另一种方式（一种是Date::Manip），
大量简单方便的方法（函数）供使用者调用。

在例子中的年和月我是自己指定的，也可以
($year, $month, $day) = Today();

颜色和闪烁是用ANSI escape sequences。
详细说明尽在ANSIColor.pm source和perldoc Term::ANSIColor里。
（perldoc Term::ANSIColor其实也在ANSIColor.pm source里） ：）

deathcult

(23) Term::Cap, Tgetend(), Tgoto, Tputs()

1. 
   
2. #!/usr/bin/perl
   
3. use strict;
   
4. use Term::Cap;
   
5. 
   
6. $| = 1;
   
7. my $i = 1;
   
8. my $flag = 0;
   
9. 
   
10. my $tcap = Term::Cap->;Tgetent({TERM =>; undef, OSPEED =>; 1});
    
11. $tcap->;Tputs('cl', 1, *STDOUT);#clear screen
    
12. 
    
13. while($i)
    
14. {
    
15.         if($i >; 50 || $flag == 1)
    
16.         {
    
17.                 $i --;
    
18.                 $flag = 1;
    
19.                 $flag = 0 if($i == 1);
    
20.         }
    
21.         else
    
22.         {
    
23.                 $i ++;       
    
24.                 $flag = 0;
    
25.         }
    
26. 
    
27.         $tcap->;Tgoto('cm', $i, 15, *STDOUT);#move cursor
    
28.         print " welcome to chinaunix! ";
    
29.         select(undef, undef, undef, 0.02);
    
30. }
    
31. exit 0;
    

复制代码

Term::Cap 终端控制模块。     
代码效果：一个左右移动的字串 "welcome to chinaunix! " ：）

deathcult

(24) HTTPD::Log::Filter

1. 
   
2. #!/usr/bin/perl
   
3. use strict;
   
4. use HTTPD::Log::Filter;
   
5. 
   
6. my $filter = HTTPD::Log::Filter->;new(format =>; "CLF",
   
7.                                                                         capture =>; ['request', 'host']);
   
8. 
   
9. foreach(`cat access_log`)
   
10. {
    
11.         chomp;
    
12.         unless( $filter->;filter($_) )
    
13.         {
    
14.                 print "[$_]\n";
    
15.                 next;
    
16.         }
    
17.         print $filter->;request, "\n";
    
18. }
    
19. exit 0;
    

复制代码

   

如果我们工作中经常需要分析Apache日志，这个模块可以提供一些方便。
创建对象实例以后，用filter方法来过滤，没有正确匹配的行将返回false,
然后用相应的方法print出我们需要的数据。(host,request,date...等等方法，
由capture选项以参数引入)
可以用re方法打印出作者所使用的匹配模式：

1. 
   
2. use HTTPD::Log::Filter;
   
3. print HTTPD::Log::Filter->;new(format=>;"CLF",capture=>;['request'])->;re;
   

复制代码

详见perldoc HTTPD::Log::Filter. enjoy it

deathcult

提供者：Apile


(25) Net::LDAP

1. 
   
2. #!/usr/bin/perl
   
3. use Net::LDAP;
   
4. 
   
5. ## get a object of ldap
   
6. $ldap = Net::LDAP->;new("1.1.1.1", port =>;"389", version =>; 3) or die "$@";
   
7. # object of Net::LDAP::Message
   
8. $mesg = $ldap->;bind($_cer_id, password =>; $_cer_pw); # 查詢用的ID/PASSWD
   
9. if($mesg->;is_error) {die $mesg->;error;}
   
10. $mesg = $ldap->;search(
    
11.                         base =>; "o=abc,c=tt", # 起始點
    
12.                         scope =>; "sub", # 範圍
    
13.                         filter =>; "(uid=apile)", # 條件
    
14.                         attrs =>; ["cn"], # 要取得的attribute
    
15.                         typesonly =>; 0        );
    
16. 
    
17. my $max_len = $mesg->;count; ## get number of entry
    
18. 
    
19. #--取得中文姓名，可能不只一筆
    
20. for($i=0;$i<$max_len;$i++){
    
21.         $entry = $mesg->;entry($i);
    
22.         $cname = $entry->;get_value("cn"); # get chinese name
    
23. }
    
24. 
    
25. #--作密碼認證
    
26. $mesg = $ldap->;bind($entry->;dn, password =>; "abc", version =>; 3)
    
27. ||die "can't connect to ldap";
    
28. if($mesg->;code) { print "verification is failed"}
    
29. else{ print "success"}
    

复制代码

LDAP version 3..可以用於查詢基本資料、驗證密碼之用..

deathcult

(26) Net::SMTP mail(), to(), data(), datasend(), auth()

1. 
   
2. #!/usr/bin/perl
   
3. 
   
4. use strict;
   
5. use Net::SMTP;
   
6. 
   
7. my $smtp = Net::SMTP->;new('smtp.sohu.com', Timeout =>; 10, Debug =>; 0)
   
8.         or die "new error\n";
   
9. #$smtp->;auth("user", "passwd") or die "auth error\n";
   
10. $smtp->;mail('some');
    
11. $smtp->;to('some@some.com');
    
12. $smtp->;data("chinaunix,哈楼你好啊!\n:)");
    
13. $smtp->;quit;
    
14. 
    
15. exit 0;
    
16. 
    

复制代码

有的SMPT Server需要Authentication，那么就使用auth()方法进行验证。
Debug模式打开，可以看到详细的SMTP命令代码。也有助于我们排错。

deathcult

(27) MIME::Base64, encode_base64(), decode_base64()

1. 
   
2. #!/usr/bin/perl -w
   
3. 
   
4. use strict;
   
5. use MIME::Base64;
   
6. 
   
7. foreach(<DATA>;)
   
8. {
   
9.         print decode_base64($_);
   
10. }
    
11. exit 0;
    
12. 
    
13. __DATA__
    
14. xOO6w6Osu7bTrcC0tb1jaGluYXVuaXguY29tIFtwZXJsXbDmIQo=
    
15. 1eLKx2Jhc2U2NLHgwuu1xMD919OjrNPJTUlNRTo6QmFzZTY0xKO/6cC0veLC66GjCg==
    
16. cGVybGRvYyBNSU1FOjpCYXNlNjQgZm9yIGRldGFpbHMsIGVuam95IGl0IDopCg==
    
17. 
    
18. 
    

复制代码

   

用来处理MIME/BASE64编码。

deathcult

(28) Net::IMAP::Simple, login(), mailboxes(), select(), get()...

1. 
   
2. #!/usr/bin/perl
   
3. 
   
4. use strict;
   
5. use Net::IMAP::Simple;
   
6. 
   
7. my $server = new Net::IMAP::Simple( 'imap.0451.com' );
   
8. $server->;login( 'user_name', 'passwd');
   
9. 
   
10. #show the mailboxs
    
11. #map {print "$_\n";} $server->;mailboxes();
    
12. 
    
13. #show mail's content
    
14. my $n = $server->;select( 'inbox' ) or die "no this folder\n";
    
15. foreach my $msg ( 1..$n )
    
16. {
    
17.     my $lines = $server->;get( $msg );
    
18.     print @$lines;
    
19.         print "_________________ Press enter key to view another! ...... __________________\n";
    
20.         read STDIN, my $key, 1;
    
21. }
    
22. 
    
23. exit 0;
    

复制代码

   

在取得中文的Folder时，会出现乱码的情况，
这个问题现在没有解决。英文的Folder则没问题。


IMAP协议，默认端口为143，可以用telnet登录。

telnet imap.xxx.com 143
2 login user pass
2 list "" *
2 select inbox
......