some perl module introduction

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

 

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; 

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

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

Data 查找替换

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