Perl扩展实战 ------ 获得ip的来源地址

1 前言

• 写这篇文章之前，听一些大牛们说，现在Perl是国内最不值钱的技术，不能给自身带来切身的利益，一般都是PHP+Mysql+Web2.0能带来丰厚的 收入，因为国内需要这样的人；且不说Perl为什么不值钱，毕竟用Perl多年，无论从Web还是脚本还是GUI界面的编程，笔者觉得Perl功能强大却 在国内如此衰弱，於心不忍。Perl能做很多事情，减少大量重复代码的开发，但是效率并不一定高效，甚至比起后起之秀python都有所不及，但perl 是自由免费的。

2 Perl扩展

2.1 什么是Perl的扩展？

• 可以简单认为非内置模块都属于Perl的扩展模块，Perl的扩展是指在本身基础上进行的一些功能改进。在 cpan 网站有各种各样的丰富模块扩展。
• 根据模块相关的定义，有些模块纯粹是在Perl的基础上扩展的；就跟盖房子似的，房子盖得越高，虽然住得人越来越多，但是后来人到达楼顶的时间也越来越多。
• 扩展可以基于 C/C++ 甚至汇编语言，程序编译成二进制后，调用其 api 函数，就好比房子上按上了一部直达楼顶电梯，这种感觉在你理解这篇文章后就会感觉得到。

2.2 一些扩展的例子

• 起先，对Web用图多的或者做过一些监测的人都应该知道鼎鼎有名的 ChartDirector ，这个是一个商业绘图软件，优秀的软件性能以及漂亮的图形让人惊叹不已；下载试用版，可以看到这些软件都是经过编译成二进制后，调用其中 api 函数运行；
• 使用过php的人应该知道 Zend软件 ，其实 Zend Optimizer 软件就是针对PHP的一个扩展，使用 Zend Guard 或 Zend Studio 将php程序压缩成二进制文件，然后使用 Zend Optimizer 来解读该二进制文件，这样不仅效率高，而且带宽、所耗资源都非常低。

2.3 两种Per扩展方法

• 目前笔者所知道有两种方法写Perl扩展，一种是 h2xs ，另外一种是 Inline::C ，以 Inline::C 为例：

package MyWrapper;
use Inline => Config => LIBS => '-L/usr/local/mylib -lmylib';
use Inline => Config => INC  => '-I/usr/local/mylib';
use Inline C;
sub version {
   return "MyWrapper 2.0";
}
__DATA__
__C__
#include "mylib.h"
   
SV* new() {
    void * session = newsession();
    SV*    obj_ref = newSViv(0);
    SV*    obj = newSVrv(obj_ref, class);
    sv_setiv(obj, (IV)session);
    SvREADONLY_on(obj);
    return obj_ref;
}
   
void set (SV* obj, char *attribute, char *value) {
    setattribute ( ((void*)SvIV(SvRV(obj))), attribute, value);
}
   
char* get (SV* obj) {
    return getresult ( ((void *)SvIV(SvRV(obj))) );
}
   
void DESTROY(SV* obj) {
    return freesession ( ((void *)SvIV(SvRV(obj))) );
}

• Inline::C 模块让人感觉代码利用率比较低，需要许多代码的重写和转换，不推荐使用，这里主要还是介绍 h2xs 工具。

2.4 用 h2xs 制作Perl扩展

1. 首先确保机器安装perl5.6以上版本（因为这个版本才会有h2xs及load工具）；
2. 接着使用 h2xs 这个工具来生成一个目录，目录中是一些扩展模块模板；
3. 根据自己的需求用Perl、C/C++或者汇编等语言写一些功能扩展；
4. 然后根据自己的需求编辑 Makefile.PL 、 module.xs 和 lib/module.pm 文件，完成Perl的扩展。

2.5 实例说明

1. 运行 h2xs 命令，生成一个 getaddress 目录：

h2xs -O -n getaddress

• 进入该目录：

$cd getaddress
$ll
total 64
drwxr-xr-x  2 lijunlia users  4096 Feb  1 16:08 t
-rw-r--r--  1 lijunlia users  1173 Feb  1 16:08 README
-rw-r--r--  1 lijunlia users 29773 Feb  1 16:08 ppport.h
-rw-r--r--  1 lijunlia users   135 Feb  1 16:08 MANIFEST
-rw-r--r--  1 lijunlia users  1780 Feb  1 16:08 Makefile.PL
drwxr-xr-x  2 lijunlia users  4096 Feb  1 16:08 lib
-rw-r--r--  1 lijunlia users   169 Feb  1 16:08 getaddress.xs
drwxr-xr-x  2 lijunlia users  4096 Feb  1 16:08 fallback
-rw-r--r--  1 lijunlia users   155 Feb  1 16:08 Changes

• 将写好的 QQWry.h 和 QQWry.c 放置该目录，QQWry.h 和 QQWry.c 文件是计算 QQWry.dat 数据的程序，相关参考文档见 纯真IP数据库格式详解；
• 接着编辑 Makefile.PL 文件，内容如下：

use 5.008005;
use ExtUtils::MakeMaker;
# See lib/ExtUtils/MakeMaker.pm for details of how to influence
# the contents of the Makefile that is written.
WriteMakefile(
    NAME              => 'getaddress',
    VERSION_FROM      => 'lib/getaddress.pm', # finds $VERSION
    PREREQ_PM         => {}, # e.g., Module::Name => 1.1
    ($] >= 5.005 ?     ## Add these new keywords supported since 5.005
      (ABSTRACT_FROM  => 'lib/getaddress.pm', # retrieve abstract from module
       AUTHOR         => 'Junliang Li <lijunlia@localdomain>') : ()),
    LIBS              => [''], # e.g., '-lm'
    DEFINE            => '', # e.g., '-DHAVE_SOMETHING'
    INC               => '-I.', # e.g., '-I. -I/usr/include/other'
        # Un-comment this if you add C files to link with later:
    # OBJECT            => '$(O_FILES)', # link all the C files too
);
if  (eval {require ExtUtils::Constant; 1}) {
  # If you edit these definitions to change the constants used by this module,
  # you will need to use the generated const-c.inc and const-xs.inc
  # files to replace their "fallback" counterparts before distributing your
  # changes.
  my @names = (qw());
  ExtUtils::Constant::WriteConstants(
                                     NAME         => 'getaddress',
                                     NAMES        => \@names,
                                     DEFAULT_TYPE => 'IV',
                                     C_FILE       => 'const-c.inc',
                                     XS_FILE      => 'const-xs.inc',
                                  );

}
else {
  use File::Copy;
  use File::Spec;
  foreach my $file ('const-c.inc', 'const-xs.inc') {
    my $fallback = File::Spec->catfile('fallback', $file);
    copy ($fallback, $file) or die "Can't copy $fallback to $file: $!";
  }
}

• 为了构造出 Makefile 文件，所有的设置在 WriteMakefile^? 这个函数里面，其中 c link file 添加：

OBJECT                    => 'getaddress.o QQWry.o',

• 修改 getaddress.xs 文件，如下：

#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"

#include "QQWry.h"
#include "ppport.h"

#include "const-c.inc"

MODULE = getaddress             PACKAGE = getaddress

INCLUDE: const-xs.inc

PROTOTYPES: DISABLE

char* getipwhere (char *filename, char *ip)
        CODE:
        {
                RETVAL = getipwhere (filename, ip);
        }
        OUTPUT:
                RETVAL

目的是生成两个目标文件：getaddress.o QQWry.o。

• lib目录的 getaddress.pm 是模块模板样例；修改 lib/getaddress.pm，若直接调用函数，只需要在 @EXPORT 里面添加其函数名称即可，如果需要使用的是面对对象的方法，模块需要使用面对对象的模块就可以了，加入函数：

# Preloaded methods go here.
sub ipwhere
{
    my $ip = shift;
    my $ipfile = shift;
    $ipfile = "data/QQWry.Dat" unless ($ipfile);
    my $ipaddr = getipwhere ($ipfile, $ip);
    return '未知地区' unless ($ipaddr);
    $ipaddr =~ s/CZ88\.NET//ig;
    $ipaddr =~ s/^\s*//;
    $ipaddr =~ s/\s*$//;
    $ipaddr = '未知地区' if (!$ipaddr || $ipaddr =~ /未知|http/i);
    return $ipaddr;
}

• 需要注意的是，若不想使用 AutoLoader^? 模块加载动态链接库，可以使用

 
require DynaLoader;
bootstrap testinfo;

加载动态链接库，

• 完整包如下：
  getaddress.tar.bz2 getaddress.tar.gz

3 测试扩展

3.1 安装扩展

• 安装扩展非常简单：

perl Makefile.PL
make
make install

• 值得注意的是，安装需要root权限；

3.2 测试效率

• 拿两个例子比较一下，一个是纯Perl写的脚本、一个是使用C语言扩展的脚本，其耗费时间如下表格：

指标	Perl	扩展	描述
消耗时间	3.739043	0.111362	600次查询的打印结果

• 其脚本例子已在完整包里面说明。

4 小结

• 通过上述实例，可以看到使用二进制的编译比普通查询快的多，若要多次进行查询，这个扩展就不合适了，因为磁盘读写最多，最好的办法还是直接读入放到内存，这样会更快一些；
• 由此看来，perl也可以通过一些二进制的编译实现一些高效率的功能，并且让过程变得更加简单；
• 此扩展在Windiws以及Linux下编译通过。