[原创] 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。
详细说明尽在[color=red]ANSIColor.pmsource[/color]和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”及相关部分。

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

Perl模块使用 = 简短例子代码集合！
Perl模块使用 => 简短例子代码集合! http://www.chinaunix.net/ 作者:deathcult 发表于:2003-06-06 17:32:55 如果你有模块使用范例(请 ...
Perl模块使用 = 简短例子代码集合（转帖）
一些常用模块的简单描述 http://www.perldoc.com/perl5.6/pod/perlmodlib.html 在perl 中使用模块: 模块的下载地址:http://www.cpan. ...
perl 模块使用范例
已有模块: 说明: 以下例子代码的测试是在FreeBSD & Solaris下进行的,Perl版本为5.005_03. (1) LWP::Simple, get() (2) Time::Hi ...
【一文弄懂】优先经验回放（PER）论文-算法-代码
[一文弄懂]优先经验回放(PER)论文-算法-代码文章目录 [一文弄懂]优先经验回放(PER)论文-算法-代码前言: 综合评价: 继续前言唠叨 per论文简述: 参考博客: 背景知识 A MOTI ...
linux perl模块检测,Linux有问必答：如何用Perl检测Linux的发行版本
提问:我需要写一个Perl程序,它会包含Linux发行版相关的代码.为此,Perl程序需要能够自动检测运行中的Linux的发行版(如Ubuntu.CentOS.Debian.Fedora等等),以及它 ...
cpan安装_生信平台搭建（五）：安装perl模块
perl模块也是生物信息分析中经常需要配置的东西,尽管很多人觉得python很流行,但是依然有大量的生物软件依赖于perl模块,如果配置不正确就无法运行,典型的就是circos,里面调用大量perl的 ...
perl模块net mysql_perl DBI模块和DBD-mysql模块安装
首先,来一段代码来自NinGoo的检测系统中已经安装的Perl模块: [root@rh65sql1 tmp]# cat check_module.pl #!/usr/bin/perl use ExtU ...
Perl 模块安装总结
从 1994 年 10 月 17 日发布的 Perl 5.000 起,Perl 增加了模块的概念,用来提供面向对象编程的能力.这是 Perl 语言发展史上的一个里程碑.此后,广大自由软件爱好者开发了大 ...
下载perl的mysql模块_安装用于操作MySQL的Perl模块
在我使用Webmin(version 1.480)管理FreeBSD主机上的MySQL数据库服务器时出现: "警告:您的系统未安装Perl 模块 DBI 和 DBD::mysql,Webmi ...

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

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

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

最新文章

热门文章