论坛 › Perl › [经验总结]Perl模块使用 => 简短例子代码集合

yunvn 发表于 2017-5-19 10:34:51

[经验总结]Perl模块使用 => 简短例子代码集合

　　





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









http://www.chinaunix.net 作者:deathcult发表于：2003-09-04 14:59:54


【发表评论】 【查看原文】 【Perl讨论区】【关闭】






如果你有模块使用范例(请尽量简洁)，请帖新贴，
或坛内邮件(主题: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::CalcCalendar(),Today()
(23)Term::Cap,Tgetend(),Tgoto,Tputs()
(24)HTTPD::Log::Filter
(25)Net::LDAP
(26)Net::SMTPmail(),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()

说明：
以下例子代码的测试是在RHLinux7.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回复于：2003-06-06 17:34:10

(1)LWP::Simple,get()


#!/usr/bin/perl-w

usestrict;

useLWP::Simpleqw(get);


my$url=shift||"http://www.chinaunix.net";

my$content=get($url);


print$content;


exit0;



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


deathcult回复于：2003-06-06 17:35:56

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

#!/usr/bin/perl-w

usestrict;

useTime::HiResqw(gettimeofdayusleep);


my($start_sec,$start_usec,$end_sec,$end_usec,$time_used);

my$micro_sec=100000;

($start_sec,$start_usec)=gettimeofday;


foreach(1..20)

{

print`date+/%H:/%M:/%S`;

usleep($micro_sec);

}


($end_sec,$end_usec)=gettimeofday;

$time_used=($end_sec-$start_sec)+($end_usec-$start_usec)/1000000;


printf("timeused:%.3fsec/n",$time_used);

exit0;



提供微秒级时间处理。


deathcult回复于：2003-06-06 17:37:00

(3)Net::FTP

#!/usr/bin/perl

usestrict;

useNet::FTP;


my$user="anonymous";

my$passwd="chinaunix@";

my$host="ftp.freebsd.org";


my$ftp=Net::FTP->;new("$host",Debug=>;0)

ordie"Can'tconnectto$host:$@/n";


$ftp->;login("$user","$passwd")

ordie"Can'tlogin/n",$ftp->;message;


$ftp->;cwd("/pub/FreeBSD/doc/")

ordie"Can'tchangedir/n",$ftp->;message;


$ftp->;get("README")

ordie"getfailed/n",$ftp->;message;


$ftp->;quit;

exit0;




deathcult回复于：2003-06-06 17:37:27

(4)Expect

#!/usr/bin/perl

usestrict;

useExpect;


my$timeout=2;

my$delay=1;

my$cmd="ssh";

my@params=qw/202.108.xx.xx-lusername-p22/;

my$pass="passwd";


my$exp=Expect->;spawn($cmd,@params)ordie"Can'tspawn$cmd/n";

$exp->;expect($timeout,-re=>;'assword:');

$exp->;send_slow($delay,"$pass/r/n");


$exp->;interact();

$exp->;hard_close();


exit0;




deathcult回复于：2003-06-06 17:37:51

(5)XML::Simple,XMLin()

#!/usr/bin/perl-w

usestrict;

useXML::Simple;


my$text=<<xml;

<?xmlversion="1.0"?>;

<web-app>;

<servlet>;

<servlet-name>;php</servlet-name>;

<servlet-class>;net.php.servlet</servlet-class>;

</servlet>;

<servlet-mapping>;

<servlet-name>;php</servlet-name>;

<url-pattern>;*.php</url-pattern>;

</servlet-mapping>;

</web-app>;

xml


my$x=XMLin($text);

foreachmy$tag(keys%$x)

{

my%h=%{$$x{$tag}};

foreach(keys%h)

{

print"$tag=>;";

print"$_=>;$h{$_}/n";

}

}

exit0;




deathcult回复于：2003-06-06 17:38:15

(6)Data::Dumper,Dumper()

#!/usr/bin/perl-w

usestrict;

useData::Dumper;


printDumper(/@INC);

printDumper(/%ENV);

exit0;




deathcult回复于：2003-06-06 17:38:39

(7)IO::Socket

#!/usr/bin/perl-w

usestrict;

useIO::Socket;


my$host="www.chinaunix.net";

my$port="80";

my$http_head="GET/HTTP/1.0/nHost:$host:$port/n/n";

my$sock=IO::Socket::INET->;new("$host:$port")

ordie"Socket()error,Reason:$!/n";


print$sock$http_head;

print<$sock>;;


exit0;




deathcult回复于：2003-06-06 18:34:26

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

#!/usr/bin/perl

usestrict;

useDate::Manip;


my$date=&DateCalc("today","-1days",0);#yesterday

my$date=&UnixDate($date,"%Y-%m-%d%T");


print"$date/n";

exit0;




deathcult回复于：2003-06-06 18:42:26

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

#!/usr/bin/perl

usestrict;

useDate::Manip;

my$date1="FriJun618:31:42GMT2003";

my$date2="2003/05/06";

my$flag=&Date_Cmp($date1,$date2);


if($flag<0)

{

print"date1isearlier!/n";

}

elsif($flag==0)

{

print"thetwodatesareidentical!/n";

}

else

{

print"date2isearlier!/n";

}

exit0;




deathcult回复于：2003-06-06 18:53:20

(10)File::Find,find()

#!/usr/bin/perl-w

usestrict;

useFile::Find;


my$file="access.log";

my$path="/";


find(/&process,$path);


subprocess{print$File::Find::dir,"$_/n"if(/$file/);}


exit0;



#用于在unix文件树结构中查找对象。


deathcult回复于：2003-06-09 21:55:40

(11)ExtUtils::Installed,new(),modules(),version()

查看已经安装的模块的相应信息。


#!/usr/bin/perl

usestrict;

useExtUtils::Installed;


my$inst=ExtUtils::Installed->;new();

my@modules=$inst->;modules();


foreach(@modules)

{

my$ver=$inst->;version($_)||"???";

printf("%-12s--%s/n",$_,$ver);

}

exit0;




deathcult回复于：2003-06-09 21:56:35

(12)DBI,connect(),prepare(),execute(),fetchrow_array()

#!/usr/bin/perl

usestrict;

useDBI;


my$dbh=DBI->;connect("dbi:mysql:dbname",'user','passwd','')

ordie"can'tconnect!/n";

my$sql=qq/showvariables/;

my$sth=$dbh->;prepare($sql);

$sth->;execute();


while(my@array=$sth->;fetchrow_array())

{

printf("%-35s",$_)foreach(@array);

print"/n";

}

$dbh->;disconnect();

exit0;




deathcult回复于：2003-06-09 21:57:22

(13)Getopt::Std

命令行参数解析。


#!/usr/bin/perl

usestrict;

useGetopt::Std;


my%opts;

getopts("c:hv",/%opts);


foreach(keys%opts)

{

/c/&&print"welcometo",$opts{$_}||"ChinaUnix","!/n";

/h/&&print"Usage:$0--/n";

/v/&&print"Thisisdemo,version0.001.001builtfor$^O/n";

}

exit0;




deathcult回复于：2003-06-09 21:58:01

(14)Proc::ProcessTable
#直接访问Unix进程表，类似pscommand。

#!/usr/bin/perl

usestrict;

useProc::ProcessTable;


my$pt=newProc::ProcessTable;


foreach(reversesort@{$pt->;table})

{

print$_->;pid,"=>;";

print$_->;cmndline,"/n";

}

exit0;




deathcult回复于：2003-06-09 21:58:36

(15)Shell

#!/usr/bin/perl

usestrict;

useShell;


print"nowis:",date();

print"currenttimeis:",date("+%T");


my@dirs=ls("-laF");

foreach(@dirs)

{

printif(///$/);#printdirectory

}

exit0;



Shell命令直接做为函数，在Perl中调用。


deathcult回复于：2003-06-10 13:59:31

AnotheruseofTime::HiResModule.

(16)Time::HiRes,sleep(),time()

#!/usr/bin/perl

usestrict;

useTime::HiResqw(sleeptime);


$|=1;

my$before=time;

formy$i(1..100)

{

print"$i/n";

sleep(0.01);

}

printf("timeused:%.5fseconds/n",time-$before);

exit0;



useTime::HiRes后，此模块提供sleep(),alarm(),time()的增强版以
取代perl内置的相应函数。
其中sleep()和alarm()的参数可以是小数。比如sleep(0.1)表示休眠0.1秒，
time()可以返回浮点数。


deathcult回复于：2003-06-10 16:06:11

(17)HTML::LinkExtor,links(),parse_file()

#!/usr/bin/perl

usestrict;

useHTML::LinkExtor;


my$p=newHTML::LinkExtor;

$p->;parse_file(*DATA);


foreachmy$links($p->;links())

{

map{print"$_"}@{$links};

print"/n";

}

exit0;




__DATA__


<!DOCTYPEhtmlPUBLIC"-//W3C//DTDXHTML1.1Strict//EN"

"http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd">;

<htmlxmlns="http://www.w3.org/1999/xhtml"xml:lang="en-US">;

<head>;

<metahttp-equiv="Content-Type"content="text/html"/>;

<title>;CPAN</title>;

<!--CopyrightJarkkoHietaniemi<jhi@iki.fi>;1998-2002

AllRightsReserved.

TheCPANLogoprovidedbyJ.C.Thorpe.

YoumaydistributethisdocumenteitherundertheArtisticLicense

(comeswithPerl)ortheGNUPublicLicense,whicheversuitsyou.


Youarenotallowedtoremoveoralterthesecomments.-->;

<!--$Id:cpan-index.html,v1.72003/02/1710:23:46jhiExp$-->;

<linkrev="made"href="mailto:cpan@perl.org">;</link>;

<styletype="text/css">;

<!--


body{

color:black;

background:white;

margin-left:2%;

margin-right:2%;

}


h1{

text-align:center;

}


img{

vertical-align:50%;

border:0;

}


.left{

text-align:left;

float:none;

}


.center{

text-align:center;

float:none;

}


.right{

text-align:right;

float:none;

}


-->;

</style>;

</head>;

<body>;


<tablewidth="100%">;

<tr>;

<tdrowspan="2">;

<divclass="left">;

<imgsrc="misc/jpg/cpan.jpg"

alt=""height="121"width="250"/>;

</div>;

</td>;

<td>;

<divclass="right">;

<h1>;<aid="top">;ComprehensivePerlArchiveNetwork</a>;</h1>;

</div>;

</td>;

</tr>;

<tr>;

<td>;

<divclass="center">;

2003-06-10onlinesince1995-10-26<br/>;1662MB246mirrors<br/>;2903authors4767modules

</div>;

</td>;

</tr>;

<tr>;

<tdcolspan="2">;

<pclass="left">;

WelcometoCPAN!HereyouwillfindAllThingsPerl.

</p>;

</td>;

<td>;

</td>;

</tr>;

</table>;


<hr/>;


<tablewidth="100%">;


<tr>;


<td>;


<h1>;Browsing</h1>;

<ul>;

<li>;<ahref="modules/index.html">;Perlmodules</a>;</li>;

<li>;<ahref="scripts/index.html">;Perlscripts</a>;</li>;

<li>;<ahref="ports/index.html">;Perlbinarydistributions("ports")</a>;</li>;

<li>;<ahref="src/README.html">;Perlsourcecode</a>;</li>;

<li>;<ahref="RECENT.html">;Perlrecentarrivals</a>;</li>;

<li>;<ahref="http://search.cpan.org/recent">;recent</a>;Perlmodules</li>;

<li>;<ahref="SITES.html">;CPANsites</a>;list</li>;

<li>;<ahref="http://mirrors.cpan.org/">;CPANsites</a>;map</li>;

</ul>;


</td>;


<td>;


<h1>;Searching</h1>;


<ul>;

<li>;<ahref="http://kobesearch.cpan.org/">;PerlcoreandCPANmodulesdocumentation</a>;(RandyKobes)</li>;

<li>;<ahref="http://www.perldoc.com/">;Perlcoredocumentation</a>;(CarlosRamirez)</li>;

<li>;<ahref="http://search.cpan.org/">;CPANmodules,distributions,andauthors</a>;(search.cpan.org)</li>;

<li>;<ahref="http://wait.cpan.org/">;CPANmodulesdocumentation</a>;(UlrichPfeifer)</li>;

</ul>;


<h1>;FAQetc</h1>;


<ul>;

<li>;<ahref="misc/cpan-faq.html">;CPANFrequentlyAskedQuestions</a>;</li>;

<li>;<ahref="http://lists.cpan.org/">;PerlMailingLists</a>;</li>;

<li>;<ahref="http://bookmarks.cpan.org/">;PerlBookmarks</a>;</li>;

</ul>;


<p>;<small>;

YoursEclectically,TheSelf-AppointedMasterLibrarian(OOK!)oftheCPAN<br/>;

<i>;JarkkoHietaniemi</i>;

<ahref="mailto:cpan@perl.org">;cpan@perl.org</a>;

<ahref="disclaimer.html">;</a>;

</small>;

</p>;


</td>;


</tr>;


</table>;


<hr/>;


<tablewidth="100%">;

<tr>;


<td>;

<divclass="left">;

<ahref="http://validator.w3.org/check?uri=http%3A%2F%2Fwww.cpan.org%2Findex.html">;

<imgsrc="misc/gif/valid-xhtml10.gif"alt="ValidXHTML1.0!"height="31"width="88"/>;</a>;

<ahref="http://jigsaw.w3.org/css-validator/validator?uri=http%3A%2F%2Fwww.cpan.org%2Findex.html">;

<imgsrc="misc/gif/vcss.gif"alt=""height="31"width="88"/>;</a>;

</div>;

</td>;

<td>;

<divclass="right">;


<tablewidth="100%">;


<tr>;

<tdclass="right">;

<small>;

CPANmastersitehostedby

</small>;

</td>;

</tr>;

<tr>;

<tdclass="right">;

<ahref="http://www.csc.fi/suomi/funet/verkko.html.en/">;<imgsrc="misc/gif/funet.gif"alt="FUNET"height="25"width="88"/>;</a>;

</td>;

</tr>;

</table>;


</div>;

</td>;


</tr>;

</table>;


</body>;

</html>;




deathcult回复于：2003-06-11 11:47:34

(18)Net::Telnet,open(),print(),getline()

#!/usr/bin/perl

usestrict;

useNet::Telnet;


my$p=Net::Telnet->;new();

my$h=shift||"www.chinaunix.net";


$p->;open(Host=>;$h,Port=>;80);

$p->;print("GET//n");

while(my$line=$p->;getline())

{

print$line;

}

exit0;




deathcult回复于：2003-06-11 14:21:45

(19)Compress::Zlib,gzopen(),gzreadline(),gzclose()

#!/usr/bin/perl

usestrict;

useCompress::Zlib;


my$gz=gzopen("a.gz","rb");


while($gz->;gzreadline(my$line)>;0)

{

chomp$line;

print"$line/n";

}


$gz->;gzclose();

exit0;



#直接使用shell的zmore,zless,zcat打开文件也不错，
但是如果gz文件很大，还是应该选择zlib。


deathcult回复于：2003-06-13 15:33:20

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

#!/usr/bin/perl

usestrict;

useNet::POP3;

useData::Dumper;


my$user="user";

my$pass=shiftordie"Usage:$0passwd/n";

my$host="pop3.web.com";#pop3address


my$p=Net::POP3->;new($host)ordie"Can'tconnect$host!/n";

$p->;login($user,$pass)ordie"userorpasswderror!/n";

my$title=$p->;listordie"Nomailfor$user/n";


foreachmy$h(keys%$title)

{

my$msg=$p->;get($h);

print@$msg;

}

$p->;quit;

exit0;



telnetpop3.web.com110也可以直接连到pop3server上，然后通过
pop3命令与邮件服务器交互，
简单的命令有：
USERname
PASSstring

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


deathcult回复于：2003-06-16 14:39:38

(21)Term::ANSIColor例子一

#!/usr/bin/perl

usestrict;

useTerm::ANSIColorqw(:constants);


$Term::ANSIColor::AUTORESET=1;


$|=1;

my$str="Welcometochinaunix^_^!/n";


formy$i(0..length($str)-1)

{

printBOLDREDsubstr($str,$i,1);

select(undef,undef,undef,0.3);

}

exit0;



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

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


deathcult回复于：2003-06-16 14:57:12

(21)Term::ANSIColor例子二

#!/usr/bin/perl

usestrict;

useTerm::ANSIColorqw(:constants);


$Term::ANSIColor::AUTORESET=1;


$|=1;


print"/e[20;40H";

my$str="Welcometochinaunix^_^!/n";


printBOLDBLINK$str;

exit0;



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

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


deathcult回复于：2003-06-16 17:13:23

(22)Date::CalcCalendar(),Today()

#!/usr/bin/perl

usestrict;

useDate::Calcqw(CalendarToday);


my$year="2003";

my$month="6";

my$day;



my$cal=Calendar($year,$month);

(undef,undef,$day)=Today();


$cal=~s/$day//e[5m/e[31m$day/e[0m/;


print$cal;

exit0;



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

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

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

颜色和闪烁是用ANSIescapesequences。
详细说明尽在ANSIColor.pmsource和perldocTerm::ANSIColor里。
（perldocTerm::ANSIColor其实也在ANSIColor.pmsource里）：）


deathcult回复于：2003-06-20 13:45:16

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

#!/usr/bin/perl

usestrict;

useTerm::Cap;


$|=1;

my$i=1;

my$flag=0;


my$tcap=Term::Cap->;Tgetent({TERM=>;undef,OSPEED=>;1});

$tcap->;Tputs('cl',1,*STDOUT);#clearscreen


while($i)

{

if($i>;50||$flag==1)

{

$i--;

$flag=1;

$flag=0if($i==1);

}

else

{

$i++;

$flag=0;

}


$tcap->;Tgoto('cm',$i,15,*STDOUT);#movecursor

print"welcometochinaunix!";

select(undef,undef,undef,0.02);

}

exit0;



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


deathcult回复于：2003-06-20 13:46:09

(24)HTTPD::Log::Filter

#!/usr/bin/perl

usestrict;

useHTTPD::Log::Filter;


my$filter=HTTPD::Log::Filter->;new(format=>;"CLF",

capture=>;['request','host']);


foreach(`cataccess_log`)

{

chomp;

unless($filter->;filter($_))

{

print"[$_]/n";

next;

}

print$filter->;request,"/n";

}

exit0;



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


useHTTPD::Log::Filter;

printHTTPD::Log::Filter->;new(format=>;"CLF",capture=>;['request'])->;re;




详见perldocHTTPD::Log::Filter.enjoyit:)


deathcult回复于：2003-06-23 10:35:01

提供者：Apile


(25)Net::LDAP

#!/usr/bin/perl

useNet::LDAP;


##getaobjectofldap

$ldap=Net::LDAP->;new("1.1.1.1",port=>;"389",version=>;3)ordie"$@";

#objectofNet::LDAP::Message

$mesg=$ldap->;bind($_cer_id,password=>;$_cer_pw);#查詢用的ID/PASSWD

if($mesg->;is_error){die$mesg->;error;}

$mesg=$ldap->;search(

base=>;"o=abc,c=tt",#起始點

scope=>;"sub",#範圍

filter=>;"(uid=apile)",#條件

attrs=>;["cn"],#要取得的attribute

typesonly=>;0);


my$max_len=$mesg->;count;##getnumberofentry


#--取得中文姓名，可能不只一筆

for($i=0;$i<$max_len;$i++){

$entry=$mesg->;entry($i);

$cname=$entry->;get_value("cn");#getchinesename

}


#--作密碼認證

$mesg=$ldap->;bind($entry->;dn,password=>;"abc",version=>;3)

||die"can'tconnecttoldap";

if($mesg->;code){print"verificationisfailed"}

else{print"success"}



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


deathcult回复于：2003-06-26 17:37:28

(26)Net::SMTPmail(),to(),data(),datasend(),auth()

#!/usr/bin/perl


usestrict;

useNet::SMTP;


my$smtp=Net::SMTP->;new('smtp.sohu.com',Timeout=>;10,Debug=>;0)

ordie"newerror/n";

#$smtp->;auth("user","passwd")ordie"autherror/n";

$smtp->;mail('some');

$smtp->;to('some@some.com');

$smtp->;data("chinaunix,哈楼你好啊!/n:)");

$smtp->;quit;


exit0;




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


deathcult回复于：2003-06-26 17:43:33

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

#!/usr/bin/perl-w


usestrict;

useMIME::Base64;


foreach(<DATA>;)

{

printdecode_base64($_);

}

exit0;


__DATA__

xOO6w6Osu7bTrcC0tb1jaGluYXVuaXguY29tIFtwZXJsXbDmIQo=

1eLKx2Jhc2U2NLHgwuu1xMD919OjrNPJTUlNRTo6QmFzZTY0xKO/6cC0veLC66GjCg==

cGVybGRvYyBNSU1FOjpCYXNlNjQgZm9yIGRldGFpbHMsIGVuam95IGl0IDopCg==





用来处理MIME/BASE64编码。


deathcult回复于：2003-07-07 18:54:45

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

#!/usr/bin/perl


usestrict;

useNet::IMAP::Simple;


my$server=newNet::IMAP::Simple('imap.0451.com');

$server->;login('user_name','passwd');


#showthemailboxs

#map{print"$_/n";}$server->;mailboxes();


#showmail'scontent

my$n=$server->;select('inbox')ordie"nothisfolder/n";

foreachmy$msg(1..$n)

{

my$lines=$server->;get($msg);

print@$lines;

print"_________________Pressenterkeytoviewanother!......__________________/n";

readSTDIN,my$key,1;

}


exit0;



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


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

telnetimap.xxx.com143
2loginuserpass
2list""*
2selectinbox
......


deathcult回复于：2003-08-01 10:44:38

提供者：flora

(29)Bio::DB::GenBank,Bio::SeqIO

bioperl(http://bioperl.org/)模块使用--生物信息学中用的模块
功能：根据核酸的gi号自动从GenBank中提取FASTA格式的序列，可以多序列提取。
代码如下：


#!/usr/bin/perl-w


useBio::DB::GenBank;

useBio::SeqIO;

my$gb=newBio::DB::GenBank;


my$seqout=newBio::SeqIO(-fh=>;/*STDOUT,-format=>;'fasta');



#ifyouwanttogetabunchofsequencesusethebatchmethod

my$seqio=$gb->;get_Stream_by_id();


while(defined($seq=$seqio->;next_seq)){

$seqout->;write_seq($seq);

}




deathcult回复于：2003-08-01 12:25:14

提供者：flora

（30）Spreadsheet::ParseExcel
perl解析Excel文件的例子。


#!/usr/bin/perl-w


usestrict;

useSpreadsheet::ParseExcel;

useSpreadsheet::ParseExcel::FmtUnicode;#gbsupport


my$oExcel=newSpreadsheet::ParseExcel;


die"Youmustprovideafilenameto$0tobeparsedasanExcelfile"unless@ARGV;

my$code=$ARGV||"CP936";#gbsupport

my$oFmtJ=Spreadsheet::ParseExcel::FmtUnicode->;new(Unicode_Map=>;$code);#gbsupport

my$oBook=$oExcel->;Parse($ARGV,$oFmtJ);

my($iR,$iC,$oWkS,$oWkC);

print"FILE:",$oBook->;{File},"/n";

print"COUNT:",$oBook->;{SheetCount},"/n";


print"AUTHOR:",$oBook->;{Author},"/n"

ifdefined$oBook->;{Author};


for(my$iSheet=0;$iSheet<$oBook->;{SheetCount};$iSheet++)

{

$oWkS=$oBook->;{Worksheet}[$iSheet];

print"---------SHEET:",$oWkS->;{Name},"/n";

for(my$iR=$oWkS->;{MinRow};

defined$oWkS->;{MaxRow}&&$iR<=$oWkS->;{MaxRow};

$iR++)

{

for(my$iC=$oWkS->;{MinCol};

defined$oWkS->;{MaxCol}&&$iC<=$oWkS->;{MaxCol};

$iC++)

{

$oWkC=$oWkS->;{Cells}[$iR][$iC];

print"($iR,$iC)=>;",$oWkC->;Value,"/n"if($oWkC);

}

}

}




deathcult回复于：2003-08-08 15:31:06

(31)Text::CSV_XS,parse(),fields(),error_input()

如果field里面也包含分隔符(比如"tom,jack,jeff","rosemike",O'neil,"kurt,korn")，那么我们解析起来确实有点麻烦，
Text::CSV_XS挺方便。


#!/usr/bin/perl


usestrict;

useText::CSV_XS;


my@columns;

my$csv=Text::CSV_XS->;new({

'binary'=>;1,

'quote_char'=>;'"',

'sep_char'=>;','

});


foreachmy$line(<DATA>;)

{

chomp$line;

if($csv->;parse($line))

{

@columns=$csv->;fields();

}

else

{

print"/n";

}


map{printf("%-14s/t",$_)}@columns;

print"/n";

}

exit0;


__DATA__

id,compact_sn,name,type,count,price

37,"ITO-2003-011","台式机,compaq","128M","290","1,2900"

35,I-BJ-2003-010,"显示器,硬盘,内存",'三星',480,"1,4800"

55,"C2003-104",笔记本,"Dell,Latitude,X200",13900,"1,13900"




deathcult回复于：2003-08-15 18:34:44

提供者：Apile

(32)Benchmark


#!/usr/bin/perl


useBenchmark;


timethese(100,

{

'local'=>;q

{

for(1..10000)

{

local$a=$_;

$a*=2;

}

},


'my'=>;q

{

for(1..10000)

{

my$a=$_;

$a*=2;

}

}

});




可以拿來算某個algorithm耗費多少時間..
timethese(做幾次iteration,{
'Algorithm名稱'=>;q{要計算時間的algorithm},
'Algorithm名稱'=>;q{要計算時間的algorithm}
});


deathcult回复于：2003-08-15 19:42:08

(33)HTTP::Daemon,accept(),get_request(),send_file_response()

一个简单的，只能处理单一请求的Web服务器模型。
send_file_response()方法能把Client请求的文件传送过去。


#!/usr/bin/perl


useHTTP::Daemon;


$|=1;

my$wwwroot="/home/doc/";

my$d=HTTP::Daemon->;new||die;

print"PerlWeb-Serverisrunningat:",$d->;url,".../n";


while(my$c=$d->;accept)

{

print$c"WelcometoPerlWeb-Server<br>;";


if(my$r=$c->;get_request)

{

print"Received:",$r->;url->;path,"/n";

$c->;send_file_response($wwwroot.$r->;url->;path);

}


$c->;close;

}




deathcult回复于：2003-08-21 15:45:32

(34)Array::Compare,compare(),full_compare()

用于数组比较。
本例实现类似shellcommand-diff的功能。
如果我们要比较的不是文件，而是比如系统信息，远程文件列表，数据库内容变化等，这个模块会给我们提供方便灵活的操作。



#!/usr/bin/perl


useArray::Compare;


$comp=Array::Compare->;new(WhiteSpace=>;1);

$cmd="top-n1|head-4";

@a1=`$cmd`;

@a2=`$cmd`;


@result=$comp->;full_compare(/@a1,/@a2);


foreach(@result)

{

print$_+1,"thline:/n";

print">;$a1[$_]>;$a2[$_]";

print"-----/n";

}

exit0;




deathcult回复于：2003-08-25 17:21:25

(35)Algorithm::Diff,diff()

用于文件比较。
实现类似unixcommanddiff的功能。


#!/usr/bin/perl


useAlgorithm::Diffqw(diff);


die("Usage:$0file1file2/n")if@ARGV!=2;


my($file1,$file2)=@ARGV;

-T$file1ordie("$file1:binary/n");

-T$file2ordie("$file2:binary/n");


@f1=`cat$file1`;

@f2=`cat$file2`;


$diffs=diff(/@f1,/@f2);


foreach$chunk(@$diffs)

{

foreach$line(@$chunk)

{

my($sign,$lineno,$text)=@$line;

printf"$sign%d%s",$lineno+1,$text;

}


print"--------/n";

}





deathcult回复于：2003-09-01 14:35:19

(36)List::Util,max(),min(),sum(),maxstr(),minstr()...

列表实用工具集。


#!/usr/bin/perl


useList::Utilqw/maxminsummaxstrminstrshuffle/;


@s=('hello','ok','china','unix');


printmax1..10;#10

printmin1..10;#1

printsum1..10;#55

printmaxstr@s;#unix

printminstr@s;#china

printshuffle1..10;#radomorder






deathcult回复于：2003-09-02 16:46:05

(37)HTML::Parser

解析HTML。本例为找出一个html文本中的所有图片的地址。（即IMG标签中的src）

子程序start中的“$tag=~/^img$/”为过滤出img标签。
如果换为“$tag=~/^a$/”，即是找出所有的链接地址。

详细的方法介绍，请见`perldocHTML::Parser`



#!/usr/bin/perl


useLWP::Simple;

useHTML::Parser;


my$url=shift||"http://www.chinaunix.net";

my$content=LWP::Simple::get($url)ordie("unknownurl/n");


my$parser=HTML::Parser->;new(

start_h=>;[/&start,"tagname,attr"],

);


$parser->;parse($content);

exit0;


substart

{

my($tag,$attr,$dtext,$origtext)=@_;

if($tag=~/^img$/)

{

if(defined$attr->;{'src'})

{

print"$attr->;{'src'}/n";

}

}

}





deathcult回复于：2003-09-04 14:46:21

(38)Mail::Sender

（1）发送附件



#!/usr/bin/perl


useMail::Sender;


$sender=newMail::Sender{

smtp=>;'localhost',

from=>;'xxx@localhost'

};

$sender->;MailFile({

to=>;'xxx@xxx.com',

subject=>;'hello',

file=>;'Attach.txt'

});

$sender->;Close();


print$Mail::Sender::Erroreq""?"sendok!/n":$Mail::Sender::Error;






deathcult回复于：2003-09-04 14:59:54

（2）发送html内容



#!/usr/bin/perl


useMail::Sender;


open(IN,"<./index.html")ordie("");


$sender=newMail::Sender{

smtp=>;'localhost',

from=>;'xxx@localhost'

};


$sender->;Open({

to=>;'xxx@xxx.com',

subject=>;'xxx',

msg=>;"hello!",

ctype=>;"text/html",

encoding=>;"7bit",

});


while(<IN>;)

{

$sender->;SendEx($_);

}

closeIN;

$sender->;Close();


print$Mail::Sender::Erroreq""?"sendok!/n":$Mail::Sender::Error;






发送带有图片或其他信息的html邮件，请看`perldocMail::Sender`
中的“SendingHTMLmessageswithinlineimages”及相关部分。

查看完整版本: [经验总结]Perl模块使用 => 简短例子代码集合