perl中调用C函数的一个例子(XS方式)

背景：因为一个临时的工作需要，花了一天的时间写了一个小程序，在perl中调用C函数（用的是XS方式），记录如下。这个程序实现了一个定制的CRC32计算（perl的Digest::CRC有一般的CRC计算，但不适用于我的应用）。

前提：
1. 安装了ActivePerl 5.8
2. 安装了VC或Dev-C++，正确设置了环境变量

操作过程如下：
1. 在命令行下执行
> h2xs -A wldemo
> cd wldemo
2. 编辑文件wldemo.xs, wldemo.xs修改后的内容如下：

/*
   CCITT crc32 perl XS implementation.
   Author: Wang Lei
   Create Date: Jan 30, 2008
  
   Usage:
       use WLDEMO;
       my @data = (0x00, 0x00, 0x00, 0x00);
       WLDEMO->crc32_init();
       printf("%x", WLDEMO->crc32(4, pack("C4", @data)));
*/
#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"
#include "ppport.h"

#define CRCPOLY   0xEDB88320UL
#define CRCINIT   0xFFFFFFFF
unsigned long c_dCrcTable32[UCHAR_MAX + 1];


MODULE = WLDEMO  PACKAGE = WLDEMO  

void
crc32_init(char *classname)
CODE:
   unsigned int i, j;
 unsigned long r;
 
 for (i = 0; i <= UCHAR_MAX; i++)
 {
     r = i;
  for (j = 0; j < CHAR_BIT; j++)
  {
      if (r & 1)
   {
       r = (r >> 1) ^ CRCPOLY;
   }
   else
   {
       r >>= 1;
   }
  }
  c_dCrcTable32[i] = r;
 }


unsigned long
crc32(char *classname, int n, char* c)
CODE:
 unsigned long r;
 unsigned char* p = (unsigned char*)c;
 
 r = CRCINIT;
 while (--n >= 0)
 {
     r = (r >> CHAR_BIT) ^ c_dCrcTable32[(unsigned char)r ^ (*p)];
     p++;
 }
 
 r = ~r;
   RETVAL = r;
OUTPUT:
   RETVAL

3. 在命令行下执行
> perl Makefile.PL
4. 编辑文件makefile，将obj替换为o (因为我使用的是gcc,如果是VC, 则不需要修改)
5. 在命令行下执行
> nmake
> nmake install
6. 测试, 测试程序如下：

use WLDEMO;

my @data1 = (0x00, 0x00, 0x00, 0x00);
my @data2 = (0xFF, 0xFF, 0xFF, 0xFF);
my @data3 = (0x01, 0x02, 0x03, 0x04);
my @data4 = (0x04, 0x03, 0x02, 0x01);
my @data5 = (0x00, 0x00, 0x00);
my @data6 = (0xFF, 0xFF, 0xFF, 0xFF, 0xFF, 0xFF);

WLDEMO->crc32_init();

printf("%x\n", WLDEMO->crc32(4, pack("C4", @data1)));
printf("%x\n", WLDEMO->crc32(4, pack("C4", @data2)));
printf("%x\n", WLDEMO->crc32(4, pack("C4", @data3)));
printf("%x\n", WLDEMO->crc32(4, pack("C4", @data4)));
printf("%x\n", WLDEMO->crc32(3, pack("C3", @data5)));
printf("%x\n", WLDEMO->crc32(5, pack("C5", @data6)));

经验：perl给C函数的参数，如果是标量比较简单，一般不需要修改；如果C函数的参数是指针，则不能直接把数组的引用传进去，应该用pack转换为字符串然后传进去。我刚开始没有用pack函数，结果计算的值一直不变。

参考资料：

http://search.cpan.org/~fayland/POD2-CN-0.02/