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

deathcult

如果你有模块使用范例(请尽量简洁)，请帖新贴，
或坛内邮件(主题:perl模块使用范例)给我，由我测试
整理以后，在此发布。
希望多多支持！

真心希望朋友们能在chinaunix受益。大家共同进步！
谢谢！ ：）     






已有模块：
说明：
以下例子代码的测试是在FreeBSD & Solaris下进行的，Perl版本为5.005_03。     

(1) LWP::Simple, get()
(2) Time::HiRes, gettimeofday(), usleep()
(3) Net::FTP
(4) Expect
(5) XML::Simple, XMLin()
(6) Data::Dumper, Dumper()
(7) IO::Socket
(8) Date::Manip, DateCalc(), UnixDate()
(9) Date::Manip, Date_Cmp()
(10) File::Find, find()
(11) ExtUtils::Installed, new(), modules(), version()
(12) DBI, connect(), prepare(), execute(), fetchrow_array()
(13) Getopt::Std
(14) Proc::ProcessTable     
(15) Shell
(16) Time::HiRes, sleep(), time()
(17) HTML::LinkExtor, links(), parse_file()
(18) Net::Telnet, open(), print(), getline()
(19) Compress::Zlib, gzopen(), gzreadline(), gzclose()
(20) Net::POP3, login(), list(), get()
(21) Term::ANSIColor
(22) Date::Calc Calendar(), Today()
(23) Term::Cap, Tgetend(), Tgoto, Tputs()
(24) HTTPD::Log::Filter
(25) Net::LDAP   
(26) Net::SMTP mail(), to(), data(), datasend(), auth()
(27) MIME::Base64, encode_base64(), decode_base64()  
(28) Net::IMAP::Simple, login(), mailboxes(), select(), get()...  
(29) Bio::DB::GenBank, Bio::SeqIO
(30) Spreadsheet::ParseExcel
(31) Text::CSV_XS, parse(), fields(), error_input()

说明：
以下例子代码的测试是在RH Linux7.2下进行的，Perl版本为5.6.0。

(32) Benchmark
(33) HTTP::Daemon, accept(), get_request()...
(34) Array::Compare, compare(), full_compare()...
(35) Algorithm::Diff, diff()
(36) List::Util, max(), min(), sum(), maxstr(), minstr()...
(37) HTML::Parser
(38) Mail::Sender

deathcult

(1) LWP::Simple, get()

1. 
   
2. #!/usr/bin/perl -w
   
3. use strict;
   
4. use LWP::Simple qw(get);
   
5. 
   
6. my $url = shift || "http://www.chinaunix.net";
   
7. my $content = get($url);
   
8. 
   
9. print $content;
   
10. 
    
11. exit 0;
    

复制代码

   

最简单方便的get网页的方法。

deathcult

(2) Time::HiRes, gettimeofday(), usleep()

1. 
   
2. #!/usr/bin/perl -w
   
3. use strict;
   
4. use Time::HiRes qw(gettimeofday usleep);
   
5. 
   
6. my ($start_sec, $start_usec, $end_sec, $end_usec, $time_used);
   
7. my $micro_sec = 100000;
   
8. ($start_sec, $start_usec) = gettimeofday;
   
9. 
   
10. foreach(1..20)
    
11. {
    
12.         print `date +\%H:\%M:\%S`;
    
13.         usleep($micro_sec);
    
14. }
    
15. 
    
16. ($end_sec, $end_usec) = gettimeofday;
    
17. $time_used = ($end_sec - $start_sec) + ($end_usec - $start_usec)/1000000;
    
18. 
    
19. printf("time used  : %.3fsec\n", $time_used);       
    
20. exit 0;   
    

复制代码

   

提供微秒级时间处理。

deathcult

(3) Net::FTP

1. 
   
2. #!/usr/bin/perl
   
3. use strict;
   
4. use Net::FTP;
   
5. 
   
6. my $user = "anonymous";
   
7. my $passwd = "chinaunix@";
   
8. my $host = "ftp.freebsd.org";
   
9. 
   
10. my $ftp = Net::FTP->;new("$host", Debug =>; 0)
    
11. or die "Can't connect to $host: $@\n";
    
12. 
    
13. $ftp->;login("$user","$passwd")
    
14. or die "Can't login\n", $ftp->;message;
    
15. 
    
16. $ftp->;cwd("/pub/FreeBSD/doc/")
    
17. or die "Can't change dir\n", $ftp->;message;
    
18. 
    
19. $ftp->;get("README")
    
20. or die "get failed\n", $ftp->;message;
    
21. 
    
22. $ftp->;quit;
    
23. exit 0;
    

复制代码

deathcult

(4) Expect

1. 
   
2. #!/usr/bin/perl
   
3. use strict;
   
4. use Expect;
   
5. 
   
6. my $timeout = 2;
   
7. my $delay = 1;
   
8. my $cmd         = "ssh";
   
9. my @params = qw/202.108.xx.xx -lusername -p22/;
   
10. my $pass = "passwd";
    
11. 
    
12. my $exp = Expect->;spawn($cmd, @params) or die "Can't spawn $cmd\n";
    
13. $exp->;expect($timeout, -re=>;'[Pp]assword:');
    
14. $exp->;send_slow($delay, "$pass\r\n");
    
15. 
    
16. $exp->;interact();
    
17. $exp->;hard_close();
    
18. 
    
19. exit 0;
    

复制代码

deathcult

(5) XML::Simple, XMLin()

1. 
   
2. #!/usr/bin/perl -w
   
3. use strict;
   
4. use XML::Simple;
   
5. 
   
6. my $text = <<xml;
   
7. <?xml version="1.0"?>;
   
8. <web-app>;
   
9.   <servlet>;
   
10.     <servlet-name>;php</servlet-name>;
    
11.     <servlet-class>;net.php.servlet</servlet-class>;
    
12.   </servlet>;
    
13.   <servlet-mapping>;
    
14.     <servlet-name>;php</servlet-name>;
    
15.     <url-pattern>;*.php</url-pattern>;
    
16.   </servlet-mapping>;
    
17. </web-app>;
    
18. xml
    
19. 
    
20. my $x = XMLin($text);
    
21. foreach my $tag(keys %$x)
    
22. {               
    
23.         my %h = %{$$x{$tag}};
    
24.         foreach(keys %h)
    
25.         {               
    
26.                 print "$tag =>; ";
    
27.                 print "$_ =>; $h{$_}\n";
    
28.         }
    
29. }
    
30. exit 0;
    

复制代码

deathcult

(6) Data:umper, Dumper()

1. 
   
2. #!/usr/bin/perl -w
   
3. use strict;
   
4. use Data::Dumper;
   
5. 
   
6. print Dumper(\@INC);
   
7. print Dumper(\%ENV);
   
8. exit 0;
   

复制代码

deathcult

(7) IO::Socket

1. 
   
2. #!/usr/bin/perl -w
   
3. use strict;
   
4. use IO::Socket;
   
5. 
   
6. my $host = "www.chinaunix.net";
   
7. my $port = "80";
   
8. my $http_head = "GET / HTTP/1.0\nHost: $host:$port\n\n";
   
9. my $sock = IO::Socket::INET->;new("$host:$port")
   
10. or die "Socket() error, Reason : $! \n";
    
11. 
    
12. print $sock $http_head;
    
13. print <$sock>;;
    
14. 
    
15. exit 0;
    

复制代码

deathcult

(8) Date::Manip, DateCalc(), UnixDate()

1. 
   
2. #!/usr/bin/perl
   
3. use strict;
   
4. use Date::Manip;
   
5. 
   
6. my $date=&DateCalc("today","-1 days", 0);#yesterday
   
7. my $date=&UnixDate($date, "%Y-%m-%d %T");
   
8. 
   
9. print "$date\n";
   
10. exit 0;
    

复制代码

deathcult

(9) Date::Manip, Date_Cmp()
#用于时间日期的比较

1. 
   
2. #!/usr/bin/perl
   
3. use strict;
   
4. use Date::Manip;
   
5. my $date1 = "Fri Jun  6 18:31:42 GMT 2003";
   
6. my $date2 = "2003/05/06";
   
7. my $flag=&Date_Cmp($date1,$date2);
   
8. 
   
9. if($flag<0)
   
10. {
    
11.         print "date1 is earlier!\n";
    
12. }
    
13. elsif($flag==0)
    
14. {
    
15.         print "the two dates are identical!\n";
    
16. }
    
17. else
    
18. {
    
19.         print "date2 is earlier!\n";
    
20. }
    
21. exit 0;
    

复制代码