perl 常用模块使用例子

于 2007-09-27 09:35:00 发布
阅读量139 收藏 1
点赞数 1
文章标签： php shell ldap
perl 常用模块使用例子------欢迎大家补充。
一些常用模块的简单描述
http://www.perldoc.com/perl5.6/pod/perlmodlib.html

在perl 中使用模块：
模块的下载地址： http://www.cpan.org/modules/01modules.index.html
安装模块：
1. perl Makefile.PL
2. make
3. make test
4. make install
也可以用如下命令安装模块(已知的适用的系统redhat 9.0,其他的我不知道，请大家试试看:).
perl -MCPAN -e shell>

接着输入:install MODEL_NAME

查看模块的帮助：
perldoc MODEL_NAME
例如：
perldoc Net::FTP


已有模块：(以下的内容转自CU，谢谢CU的朋友)
说明：
以下例子 代码的测试是在FreeBSD & Solaris下进行的，Perl版本为5.005_03。

(1) Net::FTP
(2) Net::Telnet
(3) LWP::Simple, get()
(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()
(32) Benchmark

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

(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
(39) Time::HiRes, gettimeofday(), usleep()


这里接着上面的序号：
(40) Image::Magick

以下模块在RedHat 9.0 ,perl version v5.8.0 built 通过。
(41) Data::SearchReplace

devel03-12-05 21:53
(1)Net::FTP


#!/usr/bin/perl -w
# file: ftp_recent.pl
# Figure 6.1: Downloading a single file with Net::FTP

use Net::FTP;

use constant HOST => 'ftp.perl.org';
use constant DIR => '/pub/CPAN';
use constant FILE => 'RECENT';

my $ftp = Net::FTP->new(HOST) or die "Couldn't connect: $@/n";
$ftp->login('anonymous') or die $ftp->message;
$ftp->cwd(DIR) or die $ftp->message;
$ftp->get(FILE) or die $ftp->message;
$ftp->quit;

warn "File retrieved successfully./n";

devel03-12-05 21:59
(2)Net::Telnet

#!/usr/bin/perl -w
#file:remoteps.pl
use strict;
use Net::Telnet;
use constant HOST => 'phage.cshl.org';
use constant USER => 'lstein';
use constant PASS => 'xyzzy';

my $telnet=Net::Telnet->new(HOST);
$telnet->login(USER,PASS);
my @lines=$telnet->cmd('ps -ef');
print @lines;

devel03-12-06 23:22
(3)LWP::Simple, get()
#!/usr/bin/perl -w
use strict;
use LWP::Simple qw(get);

my $url = shift || "http://www.chinaunix.net";
my $content = get($url);

print $content;

exit 0;
最简单方便的get网页的方法。

devel03-12-06 23:25
(4) Expect
<!-- php buffer start -->#!/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;
<!-- php buffer end -->

devel03-12-06 23:26
(5) XML::Simple, XMLin()
<!-- php buffer start -->#!/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;
<!-- php buffer end -->

devel03-12-06 23:33
(6) Data::Dumper, Dumper()
<!-- php buffer start -->#!/usr/bin/perl-w
usestrict;
useData::Dumper;

printDumper(@INC);
printDumper(%ENV);
exit0;
<!-- php buffer end -->

devel03-12-06 23:33
(7) IO::Socket
<!-- php buffer start -->#!/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;
<!-- php buffer end -->

devel03-12-06 23:34
(8) Date::Manip, DateCalc(), UnixDate()
<!-- php buffer start -->#!/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;
<!-- php buffer end -->

devel03-12-06 23:34
(9) Date::Manip, Date_Cmp()
#用于时间日期的比较
<!-- php buffer start -->#!/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;
<!-- php buffer end -->

devel03-12-06 23:35
(10) File::Find, find()
<!-- php buffer start -->#!/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文件树结构中查找对象。
<!-- php buffer end -->

devel03-12-06 23:35
(11) ExtUtils::Installed, new(), modules(), version()

查看已经安装的模块的相应信息。
<!-- php buffer start -->#!/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;
<!-- php buffer end -->

devel03-12-06 23:35
(12) DBI, connect(), prepare(), execute(), fetchrow_array()
<!-- php buffer start -->#!/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;
<!-- php buffer end -->

devel03-12-06 23:36
(13) Getopt::Std

命令行参数解析。
<!-- php buffer start -->#!/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;
<!-- php buffer end -->

devel03-12-06 23:36
(14) Proc::ProcessTable
#直接访问Unix进程表，类似ps command。
<!-- php buffer start -->#!/usr/bin/perl
usestrict;
useProc::ProcessTable;

my$pt=newProc::ProcessTable;

foreach(reversesort@{$pt->table})
{
print$_->pid,"=>";
print$_->cmndline,"/n";
}
exit0;
<!-- php buffer end -->
devel03-12-06 23:37
(15) Shell
<!-- php buffer start -->#!/usr/bin/perl
usestrict;
useShell;

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

my@dirs=ls("-laF");
foreach(@dirs)
{
printif(//$/);#printdirectory
}
exit0;
<!-- php buffer end -->
Shell命令直接做为函数，在Perl中调用。

devel03-12-06 23:37
Another use of Time::HiRes Module.

(16) Time::HiRes, sleep(), time()
<!-- php buffer start -->#!/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;
<!-- php buffer end -->


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

devel03-12-06 23:38
(17) HTML::LinkExtor, links(), parse_file()
<!-- php buffer start -->#!/usr/bin/perl
usestrict;
useHTML::LinkExtor;

my$p=newHTML::LinkExtor;
$p->parse_file(*DATA);

foreachmy$links($p->links())
{
map{print"$_"}@{$links};
print"/n";
}
exit0;
<!-- php buffer end -->



__DATA__
代码:
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.1 Strict//EN"
"http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd">
<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en-US">
<head>
<meta http-equiv="Content-Type" content="text/html"/>
<title>CPAN</title>
<!-- Copyright Jarkko Hietaniemi <jhi@iki.fi> 1998-2002
All Rights Reserved.
The CPAN Logo provided by J.C. Thorpe.
You may distribute this document either under the Artistic License
(comes with Perl) or the GNU Public License, whichever suits you.

You are not allowed to remove or alter these comments. -->
<!-- $Id: cpan-index.html,v 1.7 2003/02/17 10:23:46 jhi Exp $ -->
<link rev="made" href="mailto:cpan@perl.org"></link>
<style type="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>

<table width="100%">
<tr>
<td rowspan="2">
<div class="left">
<img src="misc/jpg/cpan.jpg"
alt="[CPAN Logo]" height="121" width="250"/>
</div>
</td>
<td>
<div class="right">
<h1><a id="top">Comprehensive Perl Archive Network</a></h1>
</div>
</td>
</tr>
<tr>
<td>
<div class="center">
2003-06-10 online since 1995-10-26<br/>1662 MB 246 mirrors<br/>2903 authors 4767 modules
</div>
</td>
</tr>
<tr>
<td colspan="2">
<p class="left">
Welcome to CPAN! Here you will find All Things Perl.
</p>
</td>
<td>
</td>
</tr>
</table>

<hr/>

<table width="100%">

<tr>

<td>

<h1>Browsing</h1>
<ul>
<li><a href="modules/index.html">Perl modules</a></li>
<li><a href="scripts/index.html">Perl scripts</a></li>
<li><a href="ports/index.html">Perl binary distributions ("ports")</a></li>
<li><a href="src/README.html">Perl source code</a></li>
<li><a href="RECENT.html">Perl recent arrivals</a></li>
<li><a href="http://search.cpan.org/recent">recent</a> Perl modules</li>
<li><a href="SITES.html">CPAN sites</a> list</li>
<li><a href="http://mirrors.cpan.org/">CPAN sites</a> map</li>
</ul>

</td>

<td>

<h1>Searching</h1>

<ul>
<li><a href="http://kobesearch.cpan.org/">Perl core and CPAN modules documentation </a> (Randy Kobes)</li>
<li><a href="http://www.perldoc.com/">Perl core documentation</a> (Carlos Ramirez)</li>
<li><a href="http://search.cpan.org/">CPAN modules, distributions, and authors</a> (search.cpan.org)</li>
<li><a href="http://wait.cpan.org/">CPAN modules documentation</a> (Ulrich Pfeifer)</li>
</ul>

<h1>FAQ etc</h1>

<ul>
<li><a href="misc/cpan-faq.html">CPAN Frequently Asked Questions</a></li>
<li><a href="http://lists.cpan.org/">Perl Mailing Lists</a></li>
<li><a href="http://bookmarks.cpan.org/">Perl Bookmarks</a></li>
</ul>

<p><small>
Yours Eclectically, The Self-Appointed Master Librarian (OOK!) of the CPAN<br/>
<i>Jarkko Hietaniemi</i>
<a href="mailto:cpan@perl.org">cpan@perl.org</a>
<a href="disclaimer.html">[Disclaimer]</a>
</small>
</p>

</td>

</tr>

</table>

<hr/>

<table width="100%">
<tr>

<td>
<div class="left">
<a href="http://validator.w3.org/check?uri=http%3A%2F%2Fwww.cpan.org%2Findex.html">
<img src="misc/gif/valid-xhtml10.gif" alt="Valid XHTML 1.0!" height="31" width="88"/></a>
<a href="http://jigsaw.w3.org/css-validator/validator?uri=http%3A%2F%2Fwww.cpan.org%2Findex.html">
<img src="misc/gif/vcss.gif" alt="[Valid CSS]" height="31" width="88"/></a>
</div>
</td>
<td>
<div class="right">

<table width="100%">

<tr>
<td class="right">
<small>
CPAN master site hosted by
</small>
</td>
</tr>
<tr>
<td class="right">
<a href="http://www.csc.fi/suomi/funet/verkko.html.en/"><img src="misc/gif/funet.gif" alt="FUNET" height="25" width="88"/></a>
</td>
</tr>
</table>

</div>
</td>

</tr>
</table>

</body>
</html>

devel03-12-06 23:38
18) Net::Telnet, open(), print(), getline()
<!-- php buffer start -->#!/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;
<!-- php buffer end -->

devel03-12-06 23:39
(19) Compress::Zlib, gzopen(), gzreadline(), gzclose()
<!-- php buffer start -->#!/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。
<!-- php buffer end -->

devel03-12-06 23:39
(20) Net::POP3, login(), list(), get()
<!-- php buffer start -->#!/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;
<!-- php buffer end -->
telnet pop3.web.com 110 也可以直接连到pop3 server上，然后通过
pop3命令与邮件服务器交互，
简单的命令有：
USER name
PASS string

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

devel03-12-06 23:40
(21) Term::ANSIColor 例子一
<!-- php buffer start -->#!/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;
<!-- php buffer end -->
查看ANSIColor.pm可以得知作者是利用ANSI转义序列，改变终端字符颜色的。
print "/e[34m/n";
即是改变前景色为blue;

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

devel03-12-06 23:41
(21) Term::ANSIColor 例子二
<!-- php buffer start -->#!/usr/bin/perl
usestrict;
useTerm::ANSIColorqw(:constants);

$Term::ANSIColor::AUTORESET=1;

$|=1;

print"/e[20;40H";
my$str="Welcometochinaunix^_^!/n";

printBOLDBLINK$str;
exit0;
<!-- php buffer end -->


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

devel03-12-06 23:42
(22) Date::Calc Calendar(), Today()
<!-- php buffer start -->#!/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[5me[31m$daye[0m/;

print$cal;
exit0;
<!-- php buffer end -->


本例子打印出一个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里） ：）

devel03-12-06 23:42
(23) Term::Cap, Tgetend(), Tgoto, Tputs()
<!-- php buffer start -->#!/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;
<!-- php buffer end -->
Term::Cap 终端控制模块。
代码效果：一个左右移动的字串 "welcome to chinaunix! " ：）

devel03-12-06 23:43
(24) HTTPD::Log::Filter
<!-- php buffer start -->#!/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;
<!-- php buffer end -->
如果我们工作中经常需要分析Apache日志，这个模块可以提供一些方便。
创建对象实例以后，用filter方法来过滤，没有正确匹配的行将返回false,
然后用相应的方法print出我们需要的数据。(host,request,date...等等方法，
由capture选项以参数引入)
可以用re方法打印出作者所使用的匹配模式：


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



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

devel03-12-06 23:54
提供者：Apile


(25) Net::LDAP
<!-- php buffer start -->#!/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"}
<!-- php buffer end -->

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

devel03-12-06 23:55
(26) Net::SMTP mail(), to(), data(), datasend(), auth()
<!-- php buffer start -->#!/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[b]:[/b])");
$smtp->quit;

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

devel03-12-06 23:55
(27) MIME::Base64, encode_base64(), decode_base64()
<!-- php buffer start -->#!/usr/bin/perl-w

usestrict;
useMIME::Base64;

foreach(<DATA>)
{
printdecode_base64($_);
}
exit0;
<!-- php buffer end -->
__DATA__
xOO6w6Osu7bTrcC0tb1jaGluYXVuaXguY29tIFtwZXJsXbDmIQo=
1eLKx2Jhc2U2NLHgwuu1xMD919OjrNPJTUlNRTo6QmFzZTY0xKO/6cC0veLC66GjCg==
cGVybGRvYyBNSU1FOjpCYXNlNjQgZm9yIGRldGFpbHMsIGVuam95IGl0IDopCg==


用来处理MIME/BASE64编码。

devel03-12-06 23:56
(28) Net::IMAP::Simple, login(), mailboxes(), select(), get()...
<!-- php buffer start -->#!/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;
<!-- php buffer end -->


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


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

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


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

bioperl( http://bioperl.org/)模块使用--生物信息学中用的模块
功能：根据核酸的gi号自动从GenBank中提取FASTA格式的序列，可以多序列提取。
<!-- php buffer start -->#!/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);
}
<!-- php buffer end -->

devel03-12-06 23:57
提供者：flora

（30） Spreadsheet::ParseExcel
perl解析Excel文件的例子。
<!-- php buffer start -->#!/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);
}
}
}
<!-- php buffer end -->

devel03-12-06 23:58
(31) Text::CSV_XS, parse(), fields(), error_input()

如果field里面也包含分隔符(比如"tom,jack,jeff","rose mike",O'neil,"kurt,korn")，那么我们解析起来确实有点麻烦，
Text::CSV_XS挺方便。
<!-- php buffer start -->#!/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;
<!-- php buffer end -->

__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"

devel03-12-07 00:00
提供者：Apile

(32) Benchmark
<!-- php buffer start -->#!/usr/bin/perl

useBenchmark;

timethese(100,
{
'local'=>q
{
for(1..10000)
{
local$a=$_;
$a*=2;
}
},

'my'=>q
{
for(1..10000)
{
my$a=$_;
$a*=2;
}
}
});
<!-- php buffer end -->
可以拿?硭隳硞algorithm耗費多少時間..
timethese(做幾次iteration,{
'Algorithm名稱'=>q{ 要計算時間的algorithm },
'Algorithm名稱'=>q{ 要計算時間的algorithm }
});

devel03-12-07 00:01
(33) HTTP ::Daemon, accept(), get_request(), send_file_response()

一个简单的，只能处理单一请求的Web服务器模型。
send_file_response()方法能把Client请求的文件传送过去。
<!-- php buffer start -->#!/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;
}
<!-- php buffer end -->

devel03-12-07 20:54
(34) Array::Compare, compare(), full_compare()

用于数组比较。
本例实现类似shell command - diff的功能。
如果我们要比较的不是文件，而是比如系统信息，远程文件列表，数据库内容变化等，这个模块会给我们提供方便灵活的操作。
<!-- php buffer start -->#!/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;
<!-- php buffer end -->

devel03-12-07 20:54
(35) Algorithm::Diff, diff()

用于文件比较。
实现类似unix command diff的功能。
<!-- php buffer start -->#!/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";
}
<!-- php buffer end -->

devel03-12-07 20:55
(36) List::Util, max(), min(), sum(), maxstr(), minstr()...

列表实用工具集。
<!-- php buffer start -->#!/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
<!-- php buffer end -->

devel03-12-07 20:56
(37) HTML::Parser

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

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

详细的方法介绍，请见`perldoc HTML::Parser`
<!-- php buffer start -->#!/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";
}
}
}
<!-- php buffer end -->

devel03-12-07 20:56
(38) Mail::Sender

（1）发送附件
<!-- php buffer start -->#!/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;
<!-- php buffer end -->

devel03-12-07 20:57
（2）发送html内容
<!-- php buffer start -->#!/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;
<!-- php buffer end -->
发送带有图片或其他信息的html邮件，请看`perldoc Mail::Sender`
中的“Sending HTML messages with inline images”及相关部分。

devel04-01-08 21:00
40 Image::Magick
提供者：
http://www.imagemagick.org/www/perl.html

代码:
#!/usr/local/bin/perl
use Image::Magick;

my($image, $x);

$image = Image::Magick->new;
$x = $image->Read('girl.png', 'logo.png', 'rose.png');
warn "$x" if "$x";

$x = $image->Crop(geometry=>'100x100"+100"+100');
warn "$x" if "$x";

$x = $image->Write('x.png');
warn "$x" if "$x";




The script reads three images, crops them, and writes a single image as a GIF animation sequence. In many cases you may want to access individual images of a sequence. The next example illustrates how this is done:
代码:
#!/usr/local/bin/perl
use Image::Magick;

my($image, $p, $q);

$image = new Image::Magick;
$image->Read('x1.png');
$image->Read('j*.jpg');
$image->Read('k.miff[1, 5, 3]');
$image->Contrast();
for ($x = 0; $image->[x]; $x++)
{
$image->[x]->Frame('100x200') if $image->[x]->Get('magick') eq 'GIF';
undef $image->[x] if $image->[x]->Get('columns') < 100;
}
$p = $image->[1];
$p->Draw(stroke=>'red', primitive=>'rectangle', points=>20,20 100,100');
$q = $p->Montage();
undef $image;
$q->Write('x.miff');

Suppose you want to start out with a 100 by 100 pixel white canvas with a red pixel in the center. Try

$image = Image::Magick->new;
$image->Set(size=>'100x100');
$image->ReadImage('xc:white');
$image->Set('pixel[49,49]'=>'red');

Or suppose you want to convert your color image to grayscale:

$image->Quantize(colorspace=>'gray');

Here we annotate an image with a Taipai TrueType font:

$text = 'Works like magick!';
$image->Annotate(font=>'kai.ttf', pointsize=>40, fill=>'green', text=>$text);

Other clever things you can do with a PerlMagick objects include

$i = $#$p"+1"; # return the number of images associated with object p
push(@$q, @$p); # push the images from object p onto object q
@$p = (); # delete the images but not the object p
$p->Convolve([1, 2, 1, 2, 4, 2, 1, 2, 1]); # 3x3 Gaussian kernel

devel04-04-08 18:15
41.Data::SearchReplace

代码:
use Data::SearchReplace ('sr');
sr({ SEARCH => 'searching', REPLACE => 'replacing'}, /$complex_var);

# or OO

use Data::SearchReplace;
$sr = Data::SearchReplace->new({ SEARCH => 'search for this',
REPLACE => 'replace with this' });

$sr->sr(/$complex_var);
$sr->sr(/$new_complex_var);

# if you want more control over your search/replace pattern you
# can pass an entire regex instead complete with attributes

sr({ REGEX => 's/nice/great/gi' }, /$complex_var);

# you can even use a subroutine if you'd like
# the input variable is the value and the return sets the new
# value.

sr({ CODE => sub { uc($_[0]) } }, /$complex_var);


代码:
use Data::SearchReplace qw(sr);
sr({SEARCH => 'find', REPLACE => 'replace'}, /@data);
sr({REGEX => 's/find/replace/g'}, /%data);
sr({CODE => sub {uc($_[0])} }, /@data);
iteye_14514
关注
评论
添加红包

请填写红包祝福语或标题

个

红包个数最小为10个

元

红包金额最低5元

当前余额3.43元 前往充值 >
需支付：10.00元
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付元
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明：

1.余额是钱包充值的虚拟货币，按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载，可以购买VIP、付费专栏及课程。

余额充值