用C语言扩展perl

from: http://www.loveopensource.com/?p=12

用C语言扩展perl(by linux_prog@loveopensource.com)
建议读者群：有C语言编程能力，有perl编程能力，熟悉linux

    perl经过这么多年的发展，已经成为一门非常强大的语言，在unix编程方面，perl已经包装
了几乎所有unix的系统调用。perl在字符串处理方面的能力，是其他语言望尘莫及的。其正则
表达式中的一行代码，用c语言来写的话，可能需要几千行甚至上万行代码。
    但某些时候，我们仍然需要在perl中调用C语言的类库。比如：我们用C语言开发了一个search
engine系统，我们需要在perl中去操作search engine system,这时候就需要在perl中调用search
engine的API，这些API可能就被编译成了一个链接库,比如：libsearch.so。
    怎样进行这个调用呢？
    先不解释，给大家看一个简单的例子($为shell提示符)。
$ su - root
$ h2xs -A test
$ cd test
$ vi test.xs
输入如下内容(h2xs已经为我们预生成了一部分内容)：
#include “EXTERN.h”
#include “perl.h”
#include “XSUB.h”
#include “ppport.h”

MODULE = test  PACKAGE = test  

void
hello_world(char *classname)
CODE:
  printf(”Hello World from perl xs language!\n”);

用我们熟悉的方法来编译该perl模块：
$ perl Makefile.PL
$ make
$ make install

编写perl程序来调用我们刚才生成的package:test
$ vi test.pl
输入如下内容：
#!/usr/bin/perl

use test;

test->hello_world();

$ chmod +x test.pl
$ ./test.pl
如果没有意外，程序会输出：Hello World from perl xs language!

对上面的程序来一个简单的解释：h2xs命令创建了一个用XS语言开发的perl模块，xs语言中定义了perl函数和C语言函数的
调用关系。
     相信，大家已经对perl的XS语言有了一个简单的了解，什么是XS？
     XS其实就是perl为了让perl程序员很方便的调用C程序库而开发的一个中间语言，XS语言书写者只需要在该语言中关心
perl函数和C函数的调用关系即可。
     XS的详细文档可参考：http://perldoc.perl.org/perlxs.html
其实大家看完上面的E文，我已经没有必要再继续说下去了，上面已经对XS写得很清楚了。
另外，typemap的定义也是很重要的，可以看看我写的typemap简述。
不过，为了不让这篇文档过短，下面还是要唠叨几句。

    要写出很复杂的XS程序，还有必要对perl的内部实现有一些了解。
    大家都知道，perl里只有3种类型的变量：标量，数组和散列。
    在XS里面，我们可以直接使用perl内部的这3种变量。
    标量：SV
    数组：AV
    哈希：HV
    具体可参考：http://perldoc.perl.org/perlguts.html
   
    下面帖出我做过的一个项目中的，perl XS接口定义,帮助大家更好的熟悉XS.
adli.xs
#include “EXTERN.h”
#include “perl.h”
#include “XSUB.h”

#include “ADLI/ADLI.h”

#include “ppport.h”
MODULE = ADLI  PACKAGE = ADLI  

void *
job_connect(char *classname, int jobId, char * ip, int port)
CODE:
  RETVAL = job_connect(jobId, ip, port);
OUTPUT:
  RETVAL

void *
job_start(char *classname, int jobId, char * ip, int port)
CODE:
                RETVAL = job_start(jobId, ip, port);
        OUTPUT:
                RETVAL

int
job_end(char *classname, void * hJob)
CODE:
  RETVAL = job_end(hJob);
OUTPUT:
  RETVAL

int
job_disconnect(char *classname, void * hJob)
        CODE:
                RETVAL = job_disconnect(hJob);
        OUTPUT:
                RETVAL

int
run_command(char *classname, void * hJob, char * command)
CODE:
  RETVAL = run_command(hJob, command);
OUTPUT:
  RETVAL

int
set_env(char *classname, void * hJob)
CODE:
  RETVAL = set_env(hJob);
OUTPUT:
  RETVAL

int
register_globalFile(char *classname, void * hJob, char * localFileName, char * globalFileName)
CODE:
  RETVAL = register_globalFile(hJob, localFileName, globalFileName);
OUTPUT:
  RETVAL

int
get_globalFile(char *classname, void * hJob, char * localFileName, char * globalFileName)
CODE:
  RETVAL = get_globalFile(hJob, localFileName, globalFileName);
OUTPUT:
  RETVAL

int
require_localLock(char *classname, void * hJob, char * lockName)
CODE:
  RETVAL = require_localLock(hJob, lockName);
OUTPUT:
  RETVAL

int
free_localLock(char *classname, void * hJob, char * lockName)
CODE:
  RETVAL = require_localLock(hJob, lockName);
OUTPUT:
  RETVAL

int
require_globalLock(char *classname, void * hJob, char * lockName)
CODE:
  RETVAL = require_localLock(hJob, lockName);
OUTPUT:
  RETVAL

int
free_globalLock(char *classname, void * hJob, char * lockName)
CODE:
  RETVAL = require_localLock(hJob, lockName);
OUTPUT:
  RETVAL

int
get_ClientFile(char *classname, void * hJob, int sn, char * fileName, char * localFileName)
CODE:
  RETVAL = get_ClientFile(hJob, sn, fileName, localFileName);
OUTPUT:
  RETVAL

int
get_ClientFileAll(char *classname, void * hJob, char * fileName, char * localFileName)
CODE:
  RETVAL = get_ClientFileAll(hJob, fileName, localFileName);
OUTPUT:
  RETVAL

int
set_LogFile(char *classname, char * fileName, int lLevel)
CODE:
  RETVAL = set_LogFile(fileName, lLevel);
OUTPUT:
  RETVAL

char *
get_ErrorMsg(char *classname)
CODE:
  RETVAL = get_ErrorMsg();
OUTPUT:
  RETVAL
perl调用：
#!/usr/bin/perl

use ADLI;

my $handle = ADLI->job_start($job_id, $server_ip, $server_port);
if(!$handle)
{
    die(”Start $job_id error.”);
}

if(!ADLI->run_command($handle, “myCommand”))
{
ADLI->job_end($handle);
    die(”get and fil log error.\n”);
}

typemap:
TYPEMAP
     void * T_PTROBJ

   以上希望能给对扩展perl有疑惑的人一个大概的指导。

试了一下,以前没见过这文章,还不错

文章不错。
不过【下面帖出我做过的一个项目中的，perl XS接口定义】的确设计的不好。

呵呵。。。
这个接口都是调用C的函数，哪里不好还要请斑竹指导啊。

其实根本不需要对那些 C 函数再包装一遍。
只需要按照 XS 的格式重新声明一下就可以了。
你包装了一下，不也就是加了个毫无用处的 classname 参数，然后又没用到这个参数，返回值也是 C 函数的返回值，无论是调用前还是调用后，都没有额外的代码。所以这层包装可以去掉。

比如就像这样：

void *
job_connect(int jobId, char * ip, int port);

你这里也没有用到自定义数据类型，那就连 TYPEMAP 都省了。
另外，我注意到你的 C 函数大多都需要一个 void *hJob 参数，
因此如果你愿意改造成面向对象风格接口的 Perl 模块的话，还可以采用另一套方案。

呵呵。。有道理。
不过作为给初学者的例子，还是这样老实点比较好啊。

为什么又编辑掉？
其实我的意思无非就两点：
1，如果只想实现你目前的这个目标，那么完全没必要再包装一次。
2，如果你真的需要包装一次，那么建议做成 OO 风格的。毕竟 Perl Module 大多都是 OO 的，而且你这个设计也很明显是 OO 风格的。

btw: void * 是不需要 typemap 的。

呵呵，死犟是成长的敌人。说话不要言不由衷就好。

不错！表扬一下