Perl常用模块使用例子5

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

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

——————————————————————————–
(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 }
});

——————————————————————————–
(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<br>”;

if(my $r = $c->get_request)
{
print “Received : “, $r->url->path, “/n”;
$c->send_file_response($wwwroot.$r->url->path);
}

$c->close;
}

——————————————————————————–
(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;

——————————————————————————–

(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”;
}

——————————————————————————–
(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

——————————————————————————–
(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”;
}
}
}

——————————————————————————–
(38) Mail::Sender

1)发送附件

 

#!/usr/bin/perl

use Mail::Sender;

$sender = new Mail::Sender{
smtp => ‘localhost’,
from => ‘xxx@localhost’
};
$sender->MailFile({
to => ‘[email protected]’,
subject => ‘hello’,
file => ‘Attach.txt’
});
$sender->Close();

print $Mail::Sender::Error eq “” ? “send ok!/n” : $Mail::Sender::Error;

2)发送html内容

 

#!/usr/bin/perl

use Mail::Sender;

open(IN, “< ./index.html”) or die(“”);

$sender = new Mail::Sender{
smtp => ‘localhost’,
from => ‘xxx@localhost’
};

$sender->Open({
to => ‘[email protected]’,
subject => ‘xxx’,
msg => “hello!”,
ctype => “text/html”,
encoding => “7bit”,
});

while(<IN>)
{
$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”及相关部分。

——————————————————————————–
(40) Image::Magick

http://www.imagemagick.org/www/perl.html

 

 

#!/usr/local/bin/perl
use Image::Magick;

my($image, $x);

$image = Image::Magick-&amp;gt;new;
$x = $image-&amp;gt;Read(‘girl.png’, ‘logo.png’, ‘rose.png’);
warn “$x” if “$x”;

$x = $image-&amp;gt;Crop(geometry=&amp;gt;’100×100″+100″+100′);
warn “$x” if “$x”;

$x = $image-&amp;gt;Write(‘x.png’);
warn “$x” if “$x”;

 

The script reads three images, crops them, and writes a single image as a GIF animation
sequence. In many cases you may want to access individual images of a sequence. The next
example illustrates how this is done:
#!/usr/local/bin/perl
use Image::Magick;

my($image, $p, $q);

$image = new Image::Magick;
$image-&gt;Read(‘x1.png’);
$image-&gt;Read(‘j*.jpg’);
$image-&gt;Read(‘k.miff[1, 5, 3]‘);
$image-&gt;Contrast();
for ($x = 0; $image-&gt;[x]; $x++)
{
$image-&gt;[x]-&gt;Frame(‘100×200′) if $image-&gt;[x]-&gt;Get(‘magick’) eq ‘GIF’;
undef $image-&gt;[x] if $image-&gt;[x]-&gt;Get(‘columns’) &lt; 100;
}
$p = $image-&gt;[1];
$p-&gt;Draw(stroke=&gt;’red’, primitive

 

Suppose you want to start out with a 100 by 100 pixel white canvas with a red pixel in the
center. Try

 

$image = Image::Magick->new;
$image->Set(size=>’100×100′);
$image->ReadImage(‘xc:white’);
$image->Set(‘pixel[49,49]‘=>’red’);

Or suppose you want to convert your color image to grayscale:

 

$image->Quantize(colorspace=>’gray’);

Here we annotate an image with a Taipai TrueType font:

 

$text = ‘Works like magick!’;
$image->Annotate(font=>’kai.ttf’, pointsize=>40, fill=>’green’, text=>$text);

Other clever things you can do with a PerlMagick objects include

 

$i = $#$p”+1″; # return the number of images associated with object p
push(@$q, @$p); # push the images from object p onto object q
@$p = (); # delete the images but not the object p
$p->Convolve([1, 2, 1, 2, 4, 2, 1, 2, 1]); # 3×3 Gaussian kernel

——————————————————————————————-
(41)Data::SearchReplace

 

#!/user/bin/perl
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);

<!--[if !supportLineBreakNewLine]-->
<!--[endif]-->

use Data::SearchReplace qw(sr);
sr({SEARCH => ‘find’, REPLACE => ‘replace’}, /@data);
sr({REGEX => ’s/find/replace/g’}, /%data);
sr({CODE => sub {uc($_[0])} }, /@data);