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