perl 常用模块使用例子------欢迎大家补充。

devel

提供者：flora

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

bioperl(http://bioperl.org/)模块使用--生物信息学中用的模块
功能：根据核酸的gi号自动从GenBank中提取FASTA格式的序列，可以多序列提取。[php]
#!/usr/bin/perl -w

use Bio:B::GenBank;
use Bio::SeqIO;
my $gb = new Bio:B::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);
}[/php]

devel

提供者：flora

（30） Spreadsheet:arseExcel
perl解析Excel文件的例子。[php]
#!/usr/bin/perl -w

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

my $oExcel = new Spreadsheet:arseExcel;

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:arseExcel::FmtUnicode->new(Unicode_Map => $code); #gb support
my $oBook = $oExcel->arse($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);
  }
}
}[/php]

devel

(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;[/php]

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

devel

提供者：Apile

(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;
            }
         }
   });[/php]
可以拿?硭隳硞algorithm耗費多少時間..
timethese(做幾次iteration,{
'Algorithm名稱'=>q{ 要計算時間的algorithm },
'Algorithm名稱'=>q{ 要計算時間的algorithm }
});

devel

(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 "erl 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;
}[/php]

devel

(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;[/php]

devel

(35) Algorithm:iff, diff()

用于文件比较。
实现类似unix command diff的功能。[php]
#!/usr/bin/perl

use Algorithm:iff 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";
}[/php]

devel

(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[/php]

devel

(37) HTML:arser

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

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

详细的方法介绍，请见`perldoc HTML:arser`
[php]
#!/usr/bin/perl

use LWP::Simple;
use HTML:arser;

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

my $parser = HTML:arser->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";   
      }
   }
}[/php]

devel

(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;[/php]