`
qzriso
  • 浏览: 242538 次
  • 性别: Icon_minigender_1
  • 来自: ph
社区版块
存档分类
最新评论

Perl常用模块使用例子

    博客分类:
  • 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
----------------------------------------------------------
(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";

-----------------------------------------------------------
(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;

--------------------------------------------------------------
(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网页的方法。

-------------------------------------------------------------
(4) Expect

PHP代码:

#!/usr/bin/perl
use strict;
use Expect;

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) or die "Can't spawn $cmd\n";
$exp->expect($timeout, -re=>'[Pp]assword:');
$exp->send_slow($delay, "$pass\r\n");

$exp->interact();
$exp->hard_close();

exit 0;

-----------------------------------------------------------------
5) XML::Simple, XMLin()

PHP代码:

#!/usr/bin/perl -w
use strict;
use XML::Simple;
my $text = <<xml;
< ?xml version="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);
foreach my $tag(keys %$x)
{
my %h = %{$$x{$tag}};
foreach(keys %h)
{
print "$tag => ";
print "$_ => $h{$_}\n";
}
}
exit 0;

----------------------------------------------------------------
(6) Data::Dumper, Dumper()

PHP代码:

#!/usr/bin/perl -w
use strict;
use Data::Dumper;

print Dumper(@INC);
print Dumper(%ENV);
exit 0;

-------------------------------------
(7) IO::Socket

PHP代码:

#!/usr/bin/perl -w
use strict;
use IO::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")
or die "Socket() error, Reason : $! \n";

print $sock $http_head;
print <$sock>;

exit 0;

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


PHP代码:


#!/usr/bin/perl
use strict;
use Date::Manip;
my $date1 = "Fri Jun 6 18:31:42 GMT 2003";
my $date2 = "2003/05/06";
my $flag=&Date_Cmp($date1,$date2);


if($flag<0)
{
print "date1 is earlier!\n";
}
elsif($flag==0)
{
print "the two dates are identical!\n";
}
else
{
print "date2 is earlier!\n";
}
exit 0;


--------------------------------------------------------------------
10) File::Find, find()
PHP代码:


#!/usr/bin/perl -w
use strict;
use File::Find;


my $file = "access.log";
my $path = "/";


find(&process, $path);


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


exit 0;


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


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


查看已经安装的模块的相应信息。
PHP代码:


#!/usr/bin/perl
use strict;
use ExtUtils::Installed;


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


foreach(@modules)
{
my $ver = $inst->version($_) || "???";
printf("%-12s -- %s\n", $_, $ver);
}
exit 0;


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


PHP代码:


#!/usr/bin/perl
use strict;
use DBI;


my $dbh = DBI->connect("dbi:mysql:dbname", 'user','passwd', '')
or die "can't connect!\n";
my $sql = qq/show variables/;
my $sth = $dbh->prepare($sql);
$sth->execute();


while(my @array=$sth->fetchrow_array())
{
printf("%-35s", $_) foreach(@array);
print "\n";
}
$dbh -> disconnect();
exit 0;


------------------------------------------------------------------------
(13) Getopt::Std


命令行参数解析。


PHP代码:


#!/usr/bin/perl
use strict;
use Getopt::Std;


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


foreach(keys %opts)
{
/c/ && print "welcome to ", $opts{$_} || "ChinaUnix", "!\n";
/h/ && print "Usage : $0 -[hv] -[c msg] \n";
/v/ && print "This is demo, version 0.001.001 built for $^O\n";
}
exit 0;


------------------------------------------------------------------------
(14) Proc::ProcessTable


#直接访问Unix进程表,类似ps command。


PHP代码:


#!/usr/bin/perl
use strict;
use Proc::ProcessTable;


my $pt = new Proc::ProcessTable;


foreach(reverse sort @{$pt->table})
{
print $_->pid, " => ";
print $_->cmndline, "\n";
}
exit 0;



--------------------------------------------------------------------
(15) Shell


PHP代码:


#!/usr/bin/perl
use strict;
use Shell;


print "now is : ", date();
print "current time is : ", date("+%T");


my @dirs = ls("-laF");
foreach(@dirs)
{
print if(//$/);#print directory
}
exit 0;


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


---------------------------------------------------------------------
Another use of Time::HiRes Module.


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


PHP代码:


#!/usr/bin/perl
use strict;
use Time::HiRes qw(sleep time);


$| = 1;
my $before = time;
for my $i (1..100)
{
print "$i\n";
sleep(0.01);
}
printf("time used : %.5f seconds\n", time - $before);
exit 0;



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


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


PHP代码:


#!/usr/bin/perl
use strict;
use HTML::LinkExtor;


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


foreach my $links ($p->links())
{
map {print "$_ "} @{$links};
print "\n";
}
exit 0;



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



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


PHP代码:


#!/usr/bin/perl
use strict;
use Net::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;
}
exit 0;


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


PHP代码:


#!/usr/bin/perl
use strict;
use Compress::Zlib;


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


while( $gz->gzreadline(my $line) > 0 )
{
chomp $line;
print "$line\n";
}


$gz->gzclose();
exit 0;


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


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


PHP代码:


#!/usr/bin/perl
use strict;
use Net::POP3;
use Data::Dumper;


my $user = "user";
my $pass = shift or die "Usage : $0 passwd\n";
my $host = "pop3.web.com";#pop3 address


my $p = Net::POP3->new($host) or die "Can't connect $host!\n";
$p->login($user, $pass) or die "user or passwd error!\n";
my $title = $p->list or die "No mail for $user\n";


foreach my $h(keys %$title)
{
my $msg = $p->get($h);
print @$msg;
}
$p->quit;
exit 0;


telnet pop3.web.com 110 也可以直接连到pop3 server上,然后通过pop3命令与邮件服务器交互,


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


--------------------------------------------------------------------------------
(21) Term::ANSIColor 例子一


PHP代码:


#!/usr/bin/perl
use strict;
use Term::ANSIColor qw(:constants);


$Term::ANSIColor::AUTORESET = 1;


$| = 1;
my $str = "Welcome to chinaunix ^_^!\n";


for my $i(0..length($str)-1)
{
print BOLD RED substr($str, $i, 1);
select(undef, undef, undef, 0.3);
}
exit 0;



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


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


--------------------------------------------------------------------------------
(21) Term::ANSIColor 例子二


PHP代码:


#!/usr/bin/perl
use strict;
use Term::ANSIColor qw(:constants);


$Term::ANSIColor::AUTORESET = 1;


$| = 1;


print "\e[20;40H";
my $str = "Welcome to chinaunix ^_^!\n";


print BOLD BLINK $str;
exit 0;



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


--------------------------------------------------------------------------------
(22) Date::Calc Calendar(), Today()


PHP代码:


#!/usr/bin/perl
use strict;
use Date::Calc qw(Calendar Today);


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;
exit 0;


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


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


PHP代码:


#!/usr/bin/perl
use strict;
use Term::Cap;


$| = 1;
my $i = 1;
my $flag = 0;


my $tcap = Term::Cap->Tgetent({TERM => undef, OSPEED => 1});
$tcap->Tputs('cl', 1, *STDOUT);#clear screen


while($i)
{
if($i > 50 || $flag == 1)
{
$i --;
$flag = 1;
$flag = 0 if($i == 1);
}
else
{
$i ++;
$flag = 0;
}


$tcap->Tgoto('cm', $i, 15, *STDOUT);#move cursor
print " welcome to chinaunix! ";
select(undef, undef, undef, 0.02);
}
exit 0;


Term::Cap 终端控制模块。
代码效果:一个左右移动的字串 "welcome to chinaunix! " :)


--------------------------------------------------------------------------------
(24) HTTPD::Log::Filter


PHP代码:


#!/usr/bin/perl
use strict;
use HTTPD::Log::Filter;


my $filter = HTTPD::Log::Filter->new(format => "CLF",
capture => ['request', 'host']);


foreach(`cat access_log`)
{
chomp;
unless( $filter->filter($_) )
{
print "[$_]\n";
next;
}
print $filter->request, "\n";
}
exit 0;


如果我们工作中经常需要分析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


--------------------------------------------------------------------------------
(25) Net::LDAP


PHP代码:


#!/usr/bin/perl
use Net::LDAP;


## get a object of ldap
$ldap = Net::LDAP->new("1.1.1.1", port =>"389", version => 3) or die "$@";
# object of Net::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; ## get number of entry


#--取得中文姓名,可能不只一筆
for($i=0;$i<$max_len;$i++){
$entry = $mesg->entry($i);
$cname = $entry->get_value("cn"); # get chinese name
}


#--作密碼認證
$mesg = $ldap->bind($entry->dn, password => "abc", version => 3)
||die "can't connect to ldap";
if($mesg->code) { print "verification is failed"}
else{ print "success"}


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


--------------------------------------------------------------------------------
(26) Net::SMTP mail(), to(), data(), datasend(), auth()


PHP代码:


#!/usr/bin/perl


use strict;
use Net::SMTP;


my $smtp = Net::SMTP->new('smtp.sohu.com', Timeout => 10, Debug => 0)
or die "new error\n";
#$smtp->auth("user", "passwd") or die "auth error\n";
$smtp->mail('some');
$smtp->to('some@some.com');
$smtp->data("chinaunix,哈楼你好啊!\n[b]:[/b])");
$smtp->quit;


exit 0;


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


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


PHP代码:


#!/usr/bin/perl -w


use strict;
use MIME::Base64;


foreach(<DATA>)
{
print decode_base64($_);
}
exit 0;


__DATA__
xOO6w6Osu7bTrcC0tb1jaGluYXVuaXguY29tIFtwZXJsXbDmIQo=
1eLKx2Jhc2U2NLHgwuu1xMD919OjrNPJTUlNRTo6QmFzZTY0xKO/6cC0veLC66GjCg==
cGVybGRvYyBNSU1FOjpCYXNlNjQgZm9yIGRldGFpbHMsIGVuam95IGl0IDopCg==


用来处理MIME/BASE64编码。


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


PHP代码:


#!/usr/bin/perl


use strict;
use Net::IMAP::Simple;


my $server = new Net::IMAP::Simple( 'imap.0451.com' );
$server->login( 'user_name', 'passwd');


#show the mailboxs
#map {print "$_\n";} $server->mailboxes();


#show mail's content
my $n = $server->select( 'inbox' ) or die "no this folder\n";
foreach my $msg ( 1..$n )
{
my $lines = $server->get( $msg );
print @$lines;
print "_________________ Press enter key to view another! ...... __________________\n";
read STDIN, my $key, 1;
}


exit 0;


在取得中文的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代码:
#!/usr/bin/perl -w


use Bio::DB::GenBank;
use Bio::SeqIO;
my $gb = new Bio::DB::GenBank;


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



# if you want to get a bunch of sequences use the batch method
my $seqio = $gb->get_Stream_by_id([ qw(27501445 2981014)]);


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


-------------------------------------------------------------------------
(30) Spreadsheet::ParseExcel
perl解析Excel文件的例子。


PHP代码:


#!/usr/bin/perl -w


use strict;
use Spreadsheet::ParseExcel;
use Spreadsheet::ParseExcel::FmtUnicode; #gb support


my $oExcel = new Spreadsheet::ParseExcel;


die "You must provide a filename to $0 to be parsed as an Excel file" unless @ARGV;
my $code = $ARGV[1] || "CP936"; #gb support
my $oFmtJ = Spreadsheet::ParseExcel::FmtUnicode->new(Unicode_Map => $code); #gb support
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"
if defined $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);
}
}
}


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


如果field里面也包含分隔符(比如"tom,jack,jeff","rose mike",O'neil,"kurt,korn"),那么我们
解析起来确实有点麻烦,
Text::CSV_XS挺方便。
PHP代码:
#!/usr/bin/perl


use strict;
use Text::CSV_XS;


my @columns;
my $csv = Text::CSV_XS->new({
'binary' => 1,
'quote_char' => '"',
'sep_char' => ','
});


foreach my $line(<DATA>)
{
chomp $line;
if($csv->parse($line))
{
@columns = $csv->fields();
}
else
{
print "[error line : ", $csv->error_input, "]\n";
}


map {printf("%-14s\t", $_)} @columns;
print "\n";
}
exit 0;


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


--------------------------------------------------------------------------------
(32) Benchmark


PHP代码:


#!/usr/bin/perl


use Benchmark;


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 }
});


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


一个简单的,只能处理单一请求的Web服务器模型。
send_file_response()方法能把Client请求的文件传送过去。
PHP代码:
#!/usr/bin/perl


use HTTP:: Daemon;


$| = 1;
my $wwwroot = "/home/doc/";
my $d = HTTP:: Daemon->new || die;
print "Perl Web-Server is running at: ", $d->url, " ...\n";


while (my $c = $d->accept)
{
print $c "Welcome to Perl Web-Server<br>";


if(my $r = $c->get_request)
{
print "Received : ", $r->url->path, "\n";
$c->send_file_response($wwwroot.$r->url->path);
}


$c->close;
}


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


用于数组比较。
本例实现类似shell command - diff的功能。
如果我们要比较的不是文件,而是比如系统信息,远程文件列表,数据库内容变化等,这个模块会给我们提供方便灵活的操作。
PHP代码:
#!/usr/bin/perl


use Array::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, "th line:\n";
print "> $a1[$_]> $a2[$_]";
print "-----\n";
}
exit 0;


--------------------------------------------------------------------------------
(35) Algorithm::Diff, diff()


用于文件比较。
实现类似unix command diff的功能。
PHP代码:
#!/usr/bin/perl


use Algorithm::Diff qw(diff);


die("Usage: $0 file1 file2\n") if @ARGV != 2;


my ($file1, $file2) = @ARGV;
-T $file1 or die("$file1: binary\n");
-T $file2 or die("$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";
}


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


列表实用工具集。
PHP代码:
#!/usr/bin/perl


use List::Util qw/max min sum maxstr minstr shuffle/;


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


print max 1..10; #10
print min 1..10; #1
print sum 1..10; #55
print maxstr @s; #unix
print minstr @s; #china
print shuffle 1..10; #radom order

--------------------------------------------------------------------------------
(37) HTML::Parser


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


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


详细的方法介绍,请见`perldoc HTML::Parser`


PHP代码:
#!/usr/bin/perl


use LWP::Simple;
use HTML::Parser;


my $url = shift || "http://www.chinaunix.net";
my $content = LWP::Simple::get($url) or die("unknown url\n");


my $parser = HTML::Parser->new(
start_h => [&start, "tagname, attr"],
);


$parser->parse($content);
exit 0;


sub start
{
my ($tag, $attr, $dtext, $origtext) = @_;
if($tag =~ /^img$/)
{
if (defined $attr->{'src'} )
{
print "$attr->{'src'}\n";
}
}
}


--------------------------------------------------------------------------------
(38) Mail::Sender


1)发送附件


PHP代码:


#!/usr/bin/perl


use Mail::Sender;


$sender = new Mail::Sender{
smtp => 'localhost',
from => 'xxx@localhost'
};
$sender->MailFile({
to => 'xxx@xxx.com',
subject => 'hello',
file => 'Attach.txt'
});
$sender->Close();


print $Mail::Sender::Error eq "" ? "send ok!\n" : $Mail::Sender::Error;


2)发送html内容


PHP代码:


#!/usr/bin/perl


use Mail::Sender;


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


$sender = new Mail::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($_);
}
close IN;
$sender->Close();


print $Mail::Sender::Error eq "" ? "send ok!\n" : $Mail::Sender::Error;


发送带有图片或其他信息的html邮件,请看`perldoc Mail::Sender`
中的"Sending HTML messages with inline images"及相关部分。


--------------------------------------------------------------------------------
(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


-------------------------------------------------------------------------------------------
(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);

分享到:
评论

相关推荐

    perl常用模块例子

    ### Perl常用模块详解 在Perl编程语言中,模块是封装了一组特定功能的代码集合,它们可以帮助开发者更快地实现各种复杂的功能,而无需从零开始编写所有代码。本文将详细介绍部分常用的Perl模块及其应用场景,帮助...

    windous下perl-gui编程模块 Win32-GUI-1.06-PPM-5.8

    在Windows环境下,Perl GUI编程的一个常用工具就是`Win32-GUI`模块。这款模块允许Perl程序员利用Windows API来构建本地化的桌面应用,具有良好的性能和丰富的功能。 `Win32-GUI`模块是Perl社区为Windows平台开发的...

    perl _telnet

    其中,`Net::Telnet`是Perl的一个常用模块,用于实现基于Telnet协议的远程登录操作。本文将详细解析如何利用Perl结合`Net::Telnet`模块来登录远程服务器,并执行相应的命令。 #### 一、Perl简介 Perl是一种解释型...

    modern perl文档

    其中`Modern::Perl`模块是从CPAN获取的,可以简化Perl编程环境的设置,自动导入一系列常用的特性。 - **测试框架**:当涉及到测试代码时,推荐使用如下框架: ```perl #!/usr/bin/perl use Modern::Perl; use ...

    strawberry-perl-5资源下载

    1. 全面性:它包含Perl 5解释器、标准库、以及许多常用的Perl模块,这些模块通常在Unix/Linux系统中可用,如CPAN(Comprehensive Perl Archive Network)模块。 2. 友好性:由于是为Windows设计,Strawberry Perl...

    perl 对文本一些常用操作和常用正则表达式

    Perl可以用来处理Excel文件,虽然示例代码中没有给出完整的Excel操作细节,但可以使用Perl模块如`Excel::Writer::XLSX`来进行更高级的操作。 - **设置列宽**: ```perl $worksheet-&gt;set_column(2, 33, 2); ``` - ...

    perl/tk常用命令

    Perl/Tk是Perl编程语言的一个模块,用于创建图形用户界面(GUI)。这个工具包使得Perl程序员可以方便地构建交互式的窗口应用,而无需深入学习复杂的窗口系统编程。下面是对Perl/Tk常用命令的详细说明: 1. **Tk::...

    Perl 最佳实践(CHM)

    文件I/O操作是Perl常用的功能之一,书中对文件和目录操作给出了最佳实践,如使用“Path::Tiny”模块简化文件路径处理,以及使用“IO::All”模块进行方便的文件读写。 最后,书中还涉及了性能优化和调试技巧,包括...

    perl资料

    在给定的压缩包文件“perl”中,可能包含了各种Perl学习资料、示例代码、教程或者模块。这些资源对于初学者来说,可以帮助他们快速入门Perl编程,理解其基本语法和常用技巧;对于有经验的Perl开发者,这些资料可能...

    perl源码

    "网络通信类"标签暗示了这个压缩包可能包含了与网络编程相关的Perl模块或示例代码。Perl在网络编程方面非常强大,它可以轻松地处理HTTP、FTP、SMTP等协议,以及TCP/IP套接字编程,用于创建客户端和服务器应用。 ...

    perl知识打包

    接下来,我们关注Perl的常用模块。这些模块可以帮助解决特定问题,提高开发效率: 1. **DBI (Database Interface)**:Perl的数据库接口模块,用于与各种关系型数据库进行交互,支持多种数据库驱动。 2. **LWP ...

    《PERL实例精解第4版》(原书示例代码)

    这本书的示例代码涵盖了Perl的各个方面,包括基础语法、正则表达式、文件处理、网络编程、模块开发以及各种实用脚本编写技巧。 在Perl的世界里,基础语法是学习的起点。Perl是一种动态类型的语言,它的变量声明简洁...

    perl在生物信息中的应用

    此外,还讲述了如何编写第一个Perl模块,使用模块,以及如何利用CPAN(Comprehensive Perl Archive Network)中的模块。CPAN是Perl社区的一个庞大资源库,提供了成千上万的Perl模块,可以帮助用户解决各种问题。 第...

    perl_TimeDate.rar_activeperl timeda_perl TimeDate_perl Timeda_pe

    然而,在这里提到的可能是ActivePerl的环境,ActivePerl是Perl的一种预编译版本,包含了大部分常用的Perl模块,包括Time::Date。因此,如果你使用ActivePerl,可能已经内置了这个模块,可以直接使用。 Time::Date...

    perl自动发邮件

    Perl提供了多个模块来处理电子邮件的发送,其中最常用的是`Email::Sender`系列模块,如`Email::Sender::Simple`用于基础的邮件发送,`Email::Sender::Transport`系列模块处理实际的传输机制,比如通过SMTP服务器发送...

    extending and embeding Perl

    通过上述分析可以看出,《扩展与嵌入Perl》这本书旨在为读者提供从理论到实践全面覆盖的知识体系,帮助他们掌握如何使用C语言编写高效的Perl扩展模块,并能够将Perl嵌入到其他应用程序中,以充分发挥Perl语言的强大...

    Perl program

    在CHM格式的“Perl语言编程”书中,读者可以期待找到关于这些概念的深入讲解,包括基本语法、常用函数、正则表达式、模块使用以及面向对象编程的实例。这本书将帮助读者逐步掌握Perl编程,无论是初学者还是有一定...

    The Perl Programming Language

    Perl支持多种数据库操作,常用的有DBI(Database Interface for Perl)模块,它提供了一个统一的接口来访问不同的数据库系统。 ##### 5.5 进程和IPC Perl支持进程间的通信(Interprocess Communication),包括...

    perl cgi

    Perl因为其灵活性和丰富的库支持,成为了编写CGI程序的常用语言。 要开始编写Perl CGI程序,首先需要安装Perl解释器和CGI模块。在Unix或Linux系统中,通常Perl已经预装,而CGI模块可以通过CPAN(Comprehensive Perl...

Global site tag (gtag.js) - Google Analytics