|
|
[原创] 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=>;'[Pp]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-[hv]-[cmsg]/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="[CPANLogo]"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">;[Disclaimer]</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="[ValidCSS]"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[n]
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([qw(275014452981014)]);
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[1]||"CP936";#gbsupport
my$oFmtJ=Spreadsheet::ParseExcel::FmtUnicode->;new(Unicode_Map=>;$code);#gbsupport
my$oBook=$oExcel->;Parse($ARGV[0],$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"[errorline:",$csv->;error_input,"]/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”及相关部分。
|
|
QQ群⑧：
窥视卡
雷达卡
发表于 2017-5-19 10:34:51
提升卡
置顶卡
沉默卡
喧嚣卡
变色卡
千斤顶
显身卡