Perl Cookbook

Table of Contents

1 Perl 环境

1.1 Module::CoreList

列出本地所有模块，以及是否是核心模块： 

# filename: corelist.pl

use Module::CoreList;

if ($ARGV[0]) {
    foreach (Module::CoreList::find_modules(qr/$ARGV[0]/)) {
        printf "%s $_\n", Module::CoreList::is_core($_);
    }
}

1.2 REPL

最简单的，使用 Perl 的调试器： 

$ perl -de1

参数 -e 后面可以跟任意表达式。

Perl 调试器默认使用的 Term::ReadLine 来处理交互式，Term::ReadLine 不支持 shell 的快捷键，如需要快捷键支持就安装 Term::ReadLine::Gnu。

2 数据格式

2.1 JSON

use JSON;

my %hash = ("a" => 1,
            "b" => 2);

print to_json(\%hash);

my $str = '{"msg": "hello world"}';
my $hash_ref = from_json($str);

3 正则表达式

Regexp::Common 模块中有非常多比较常见的正则表达式可以直接拿来使用，比如验证 IP 地址的： 

use Regexp::Common;
print "yes" if "127.0.0.1" =~ /^$RE{net}{IPv4}$/;

4 线程

多线程示例：获得域名列表中每个域名的 whois 数据： 

use v5.10;
use threads;
use Thread::Queue;
use Domain::PublicSuffix;

use constant THREAD_POOL_SIZE => 100;
my $thread_total = 100;
my $suffix = Domain::PublicSuffix->new();
my $queue = Thread::Queue->new();
my @threads;

open F, "<", "all_host";

foreach my $line (<F>) {
  chomp($line);
  $queue->enqueue($line);
}
$queue->end();
close F;

for(1..THREAD_POOL_SIZE) {
  push @threads, threads->create(sub {
    while (defined(my $domain = $queue->dequeue)) {
      $root = $suffix->get_root_domain($domain);
      my $whois_info = `whois $root`;
      say $whois_info;
    }
  })
}

$_->join for @threads;

5 HTTP

5.1 Web请求

GET 请求： 

use LWP::UserAgent;

my $ua = LWP::UserAgent->new;
my $resp = $ua->get("http://www.shellcodes.org");

if ($resp->is_success) {
    print $resp->content;
} else {
    print 'error';
}

POST 请求： 

use LWP::UserAgent;

my $ua = LWP::UserAgent->new;
my $resp = $ua->post("http://host/login.php", [
                         "user" => "admin",
                         "password" => "admin",
                     ]);

if ($resp->is_success) {
    print $resp->content;
} else {
    print 'error';
}

5.2 TLD

effective_tld_names.dat 下载链接：http://publicsuffix.org/list/effective_tld_names.dat 

perl -MDomain::PublicSuffix -nle 'BEGIN{$s = Domain::PublicSuffix->new({'data_file' => "effective_tld_names.dat"})};chomp($_);print $s->get_root_domain($_)'

或： 

perl -MIO::Socket::SSL::PublicSuffix -ne 'BEGIN{$ps = IO::Socket::SSL::PublicSuffix->from_file("effective_tld_names.dat")};chomp($_);$rootdomain = $ps->public_suffix($_, 1);print $rootdomain."\n"

6 调试 Perl

进入调试器：perl -d [perl_file]

更多调试器用法请用 h 命令，或参考 perldebug 文档： 

$ perldoc perldebug

6.1 Data::Dump

可以把复杂的数据结构打印出拉： 

use Data::Dumper;

my %hash = ("a" => 1,
            "b" => 2);

print Dumper(\%hash);

输出： 

$VAR1 = {
          'b' => 2,
          'a' => 1
        };

Data::Dump 模块的 dump 子程序打印出来的要更美观点： 

use Data::Dump qw(dump);

my %hash = ("a" => 1,
            "b" => 2);

print dump(\%hash);

输出： 

{ a => 1, b => 2 }

6.2 Dumpvalue

use strict;
use Dumpvalue;

my $dump = Dumpvalue->new();
my $hash = {
            name => 'lu4nx',
            blog => 'www.shellcodes.org'
           };

$dump->dumpValue(\$hash);

运行输出： 

-> HASH(0x23a7f48)
   'blog' => 'www.shellcodes.org'
   'name' => 'lu4nx'

6.3 B::Deparse

当遇到比较复杂的 Perl 代码时，可以用 B::Deparse 模块来查看 Perl 编译器解析后的样子，便于调试源码。

比如以下一段 JAPH 代码： 

$_='987;s/^(\d+)/$1-1/e;$1?eval:print"Just another Perl hacker,"';eval;

保存为 japh.pl，调用 B::Deparse 模块： 

$ perl -MO=Deparse -f japh.pl

输出如下： 

$_ = '987;s/^(\\d+)/$1-1/e;$1?eval:print"Just another Perl hacker,"';
eval $_;
japh.pl syntax OK

7 unpack

显示字符串的 16 进制内容： 

print unpack('H*', 'hello world') # => 68656c6c6f20776f726c64

8 输入输出

select：改变 print、write 的输出句柄： 

use strict;

open my $f, '>', 'output';
select($f);
print 'hello world';

将打印的内容输出到文件“output”中。

9 BEGIN、CHECK、INIT 和 END 块

先看这段代码： 

use 5.010;

say 'hello';

BEGIN {
  say 'in BEGIN block';
}

运行输出如下： 

in BEGIN block
hello

借助 Deparse 模块： 

$  perl -MO=Deparse -f test.pl
in BEGIN block
sub BEGIN {
    require 5.01;
}
no feature ':all';
use feature ':5.10';
say 'hello';
sub BEGIN {
    say 'in BEGIN block';
}
test.pl syntax OK

可以看到，use 5.010 实质上被转换成： 

sub BEGIN {
    require 5.01;
}

Perl 在初始化时首先执行 BEGIN 块的代码。

在初始化完成后，会再执行 CHECK 块，修改下代码： 

use 5.010;

say 'hello';

BEGIN {
  say 'in BEGIN block';
}

CHECK {
  say 'in CHECK block';
}

运行输出： 

in BEGIN block
in CHECK block
hello

CHECK 块有点特殊，如果代码里出现多个 CHECK 块，Perl 首先执行最后一个： 

use 5.010;

CHECK {
  say 'CHECK1';
}

CHECK {
  say 'CHECK2';
}

CHECK {
  say 'CHECK3';
}

运行输出： 

CHECK3
CHECK2
CHECK1

INIT 块在所有 CHECK 块执行完后才执行： 

use 5.01000;

say 'hello';

BEGIN {
  say 'in BEGIN block';
}

CHECK {
  say 'in CHECK block';
}

INIT {
  say 'in INIT block';
}

输出如下： 

in BEGIN block
in CHECK block
in INIT block
hello

最终程序在退出前执行 END 块的内容： 

use 5.01000;

say 'hello';

BEGIN {
  say 'in BEGIN block';
}

CHECK {
  say 'in CHECK block';
}

INIT {
  say 'in INIT block';
}

END {
  say 'bye';
}

输出： 

in BEGIN block
in CHECK block
in INIT block
hello
bye

10 goto

goto 语句可改变程序的执行流程，可以跳转到指定的 LABEL 块或者函数中运行。

例： 

my $sum = 0;
LOOP:do {
  if ($sum % 2 == 0) {
    $sum++;
    goto LOOP;
  }
  print $sum, "\n";
  $sum++;
} while($sum < 10);

上面代码中 LOOP 就是一个 LABEL 块，这个 LABEL 标签也可以靠表达式来生成，现在，我修改成通过函数调用返回字符串： 

sub make_label {
  return 'LOOP';
}

my $sum = 0;
make_label:
  do {
  if ($sum % 2 == 0) {
    $sum++;
    goto make_label;
  }
  print $sum, "\n";
  $sum++;
} while($sum < 10);

goto 也可以改变函数内部执行流程，将当前执行的子程序替换成别的子程序： 

sub hello {
  print "hello world\n";
}

sub test {
  goto &hello;
  print "end\n";
}

test

输出：hello world