科技讯息网 – 程序员的那点事!

首页 > 编程资料 > Perl语言 > 正文

Perl模块使用 => 简短例子代码集合!

浏览次数:次 2003年09月04日 作者:deathcult 字号:

如果你有模块使用范例(请尽量简洁),请帖新贴,
或坛内邮件(主题: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::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()

说明:
以下例子代码的测试是在RH?Linux7.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
use?strict;
use?LWP::Simple?qw(get);

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

print?$content;

exit?0;
?????

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


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

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

#!/usr/bin/perl?-w
use?strict;
use?Time::HiRes?qw(gettimeofday?usleep);

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("time?used??:?%.3fsec\n",?$time_used);
exit?0;????
?????

提供微秒级时间处理。


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

(3)?Net::FTP

#!/usr/bin/perl
use?strict;
use?Net::FTP;

my?$user?=?"anonymous";
my?$passwd?=?"chinaunix@";
my?$host?=?"ftp.freebsd.org";

my?$ftp?=?Net::FTP->;new("$host",?Debug?=>;?0)
or?die?"Can't?connect?to?$host:?$@\n";

$ftp->;login("$user","$passwd")
or?die?"Can't?login\n",?$ftp->;message;

$ftp->;cwd("/pub/FreeBSD/doc/")
or?die?"Can't?change?dir\n",?$ftp->;message;

$ftp->;get("README")
or?die?"get?failed\n",?$ftp->;message;

$ftp->;quit;
exit?0;



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

(4)?Expect

#!/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;



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

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

#!/usr/bin/perl?-w
use?strict;
use?XML::Simple;

my?$text?=?<<>
;?
;
??;
????;php;
????;net.php.servlet;
??
;
??;
????;php;
????;*.php;
??
;
;?
xml

my?$x?=?XMLin($text);
foreach?my?$tag(keys?%$x)
{
my?%h?=?%{$$x{$tag}};
foreach(keys?%h)
{
print?"$tag?=>;?";
print?"$_?=>;?$h{$_}\n";
}
}
exit?0;



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

(6)?Data::Dumper,?Dumper()

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

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



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

(7)?IO::Socket

#!/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;



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

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

#!/usr/bin/perl
use?strict;
use?Date::Manip;

my?$date=&DateCalc("today","-1?days",?0);#yesterday
my?$date=&UnixDate($date,?"%Y-%m-%d?%T");

print?"$date\n";
exit?0;



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

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

#!/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;



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

(10)?File::Find,?find()

#!/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文件树结构中查找对象。


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

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

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


#!/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;



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

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

#!/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;



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

(13)?Getopt::Std

命令行参数解析。


#!/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;



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

(14)?Proc::ProcessTable
#直接访问Unix进程表,类似ps?command。

#!/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;



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

(15)?Shell

#!/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中调用。


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

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

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

#!/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()可以返回浮点数。


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

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

#!/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__

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

;
?;
??;
???;
????
?????????alt="[CPAN?Logo]"?height="121"?width="250"/>;
???
;
??;
??;
???;
????

;;Comprehensive?Perl?Archive?Network;

;
???
;
??;
?;
?;
??;
????;
????2003-06-10?online?since?1995-10-26
;1662?MB?246?mirrors
;2903?authors?4767?modules
????
;
??;
?;
?;
??;
???;
Welcome?to?CPAN!?Here?you?will?find?All?Things?Perl.
???;
??;
??;
??;
?
;
;


;

;

;

;

;Browsing

;
    ;
    ??
  • ;;Perl?modules;
  • ;
    ??
  • ;;Perl?scripts;
  • ;
    ??
  • ;;Perl?binary?distributions?("ports");
  • ;
    ??
  • ;;Perl?source?code;
  • ;
    ??
  • ;;Perl?recent?arrivals;
  • ;
    ??
  • ;;recent;?Perl?modules
  • ;
    ??
  • ;;CPAN?sites;?list
  • ;
    ??
  • ;;CPAN?sites;?map
  • ;
;

;

;

;Searching

;

    ;
  • ;;Perl?core?and?CPAN?modules?documentation?;?(Randy?Kobes)
  • ;
  • ;;Perl?core?documentation;?(Carlos?Ramirez)
  • ;
  • ;;CPAN?modules,?distributions,?and?authors;?(search.cpan.org)
  • ;
  • ;;CPAN?modules?documentation;?(Ulrich?Pfeifer)
  • ;
;

;FAQ?etc

;

    ;
  • ;;CPAN?Frequently?Asked?Questions;
  • ;
  • ;;Perl?Mailing?Lists;
  • ;
  • ;;Perl?Bookmarks;
  • ;
;

;;
Yours?Eclectically,?The?Self-Appointed?Master?Librarian?(OOK!)?of?the?CPAN
;
;Jarkko?Hietaniemi;
;cpan@perl.org;
;[Disclaimer];
;

;

;

;

;


;

;
;

;
;
;
;;
;
;;
;
;
;
;

;

;
;
;
CPAN?master?site?hosted?by
;
;
;
;
;
;;;
;
;
;

;
;

;
;

;
;



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

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

#!/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;



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

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

#!/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。


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

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

#!/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来做一个收信件的简单程序。


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

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

#!/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)


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

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

#!/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";

详细请搜索精华。还有perldoc?Term::ANSIColor?。


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

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

#!/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[5m\e[31m$day\e[0m/;

print?$cal;
exit?0;
?????

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

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

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

颜色和闪烁是用ANSI?escape?sequences。
详细说明尽在[color=red]ANSIColor.pm?source[/color]和perldoc?Term::ANSIColor里。
(perldoc?Term::ANSIColor其实也在ANSIColor.pm?source里)?:)


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

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

#!/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!?"?:)


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

(24)?HTTPD::Log::Filter

#!/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?:)


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

提供者:Apile


(25)?Net::LDAP

#!/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..可以用於查询基本资料、验证密码之用..


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

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

#!/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:)");
$smtp->;quit;

exit?0;



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


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

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

#!/usr/bin/perl?-w

use?strict;
use?MIME::Base64;

foreach(;)
{
print?decode_base64($_);
}
exit?0;

__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

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


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

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



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

提供者:flora

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


#!/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?;{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","rose?mike",O'neil,"kurt,korn"),那么我们解析起来确实有点麻烦,
Text::CSV_XS挺方便。


#!/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(;)
{
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"



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

提供者:Apile

(32)?Benchmark


#!/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?}?
});


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

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

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


#!/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
;";

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

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



#!/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;



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

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

用于文件比较。
实现类似unix?command?diff的功能。


#!/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";
}




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

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

列表实用工具集。


#!/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





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

(37)?HTML::Parser

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

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

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



#!/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";
}
}
}




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

(38)?Mail::Sender

(1)发送附件



#!/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;





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

(2)发送html内容



#!/usr/bin/perl

use?Mail::Sender;

open(IN,?"
$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(;)
{
$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”及相关部分。