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