tar包位置：http://www.cppblog.com/Files/changup/c_perl.tar
本次测试比较完整的一个c文件，贴出来，请高人指点完善，争取大家实际中能用好，毕竟感觉在程序中嵌入解释性的脚本是非常好的，尤其针对复杂多变的业务逻辑部分；
#include <stdio.h>
#include <string.h>
#include <stdlib.h>
#include <EXTERN.h>
#include <perl.h>
static PerlInterpreter* my_perl;
#define CALLFUN_BEGIN dSP; \
ENTER; \
SAVETMPS; \
PUSHMARK(SP);
#define CALLFUN_END FREETMPS;\
LEAVE;
void initperlenv(int argc, char* argv[])
{
my_perl = perl_alloc();
perl_construct(my_perl);
perl_parse(my_perl, NULL, argc, argv, (char **)NULL);
}
void destroyperlenv()
{
perl_destruct(my_perl);
perl_free(my_perl);
}
/* 普通perl标量的操作
*/
void SV_test()
{
//创建
SV* sv_i = newSViv(99);
SV* sv_n = newSVnv(23.45);
SV* sv_p = newSVpv("test string",0);
SV* funstring = 0;
//将变量设置为mortal；
sv_2mortal(sv_i);
sv_2mortal(sv_n);
sv_2mortal(sv_p);
//探测类型
if(SvIOK(sv_i))
{
printf("sv_i is a int type,value=%d\n", *(int*)(sv_i->sv_any));
}
else
{
printf("sv_i is not a int type\n");
}
if(SvNOK(sv_n))
{
printf("sv_n is a double type\n");
}
else
{
printf("sv_n is not a double type\n");
}
if(SvPOK(sv_p))
{
printf("sv_p is a string type\n");
}
else
{
printf("sv_p is not a string type\n");
}
//探测类型，这次打印出的是类型的宏定义
printf("sv_i.type=%u\n", SvTYPE(sv_i));
printf("sv_n.type=%u\n", SvTYPE(sv_n));
printf("sv_p.type=%u\n", SvTYPE(sv_p));
//以优美的格式打印标量
sv_dump(sv_i);
sv_dump(sv_n);
sv_dump(sv_p);
//修改值
sv_setiv(sv_i,89);
sv_dump(sv_i);
sv_setnv(sv_n,89.76);
sv_dump(sv_n);
sv_setpv(sv_p,"String changed");
sv_dump(sv_p);
//操作pl脚本中的文件
funstring = perl_get_sv("main::getstring",1); //没有得到值
sv_dump(funstring);
}
/* 操作perl函数
sub fun1()
{
$username = shift;
$arg = shift;
print "your name=$username,your arg=$arg\n";
return 88;
}
*/
int call_fun()
{
//调用函数前的perl堆栈操作
CALLFUN_BEGIN;
//参数入栈
XPUSHs(sv_2mortal(newSVpv("changym",0)));
XPUSHs(sv_2mortal(newSViv(32)));
PUTBACK; //表示参数完了
//调用函数
perl_call_pv("fun1",G_SCALAR); //G_SCALAR---返回标量;G_ARRAY--返回数组
/*
#define G_SCALAR 0
#define G_ARRAY 1
#define G_VOID 128 /* skip this bit when adding flags below */
//extra flags for Perl_call_* routines
//#define G_DISCARD 2 /* Call FREETMPS. */
//#define G_EVAL 4 /* Assume eval {} around subroutine call. */
//#define G_NOARGS 8 /* Don't construct a @_ array. */
//#define G_KEEPERR 16 /* Append errors to $@, don't overwrite it */
//#define G_NODEBUG 32 /* Disable debugging at toplevel. */
//#define G_METHOD 64 /* Calling method. */
//开始操作返回值了
SPAGAIN;
printf("inner ibm.pl,fun1 return %s\n",POPp); //POPi---int, POPp--pchar
PUTBACK; //表示返回值取完了
//perl栈资源回收
CALLFUN_END;
return 0;
}
/* 操作perl函数,perl 函数返回一个数组
sub return_array()
{
@arr = ("changym","chenjx","changjr","xiaobaobao");
print "inner ibm.pl.return_array:@arr\n";
}
*/
int call_fun_ret_array()
{
int ireturn = 0;
STRLEN n_a; //诡异的现象，非要定义这个否则打印值的哪行就报错
//ibm.c:162: `n_a' undeclared (first use in this function)
//同样的问题就是PerlInterpreter的名字必须叫my_perl,为什么啊？
//调用函数前的perl堆栈操作
CALLFUN_BEGIN;
PUTBACK; //表示参数完了
//调用函数
ireturn = perl_call_pv("return_array",G_ARRAY); //G_SCALAR---返回标量;G_ARRAY--返回数组
//开始操作返回值了
SPAGAIN;
if(ireturn>0)
{
while(ireturn>0)
{
//返回的顺序是数组的倒叙啊？
printf("coming from ibm.pl.return_array:%d-%s\n",ireturn--,POPpx);
}
}
PUTBACK; //表示返回值取完了
//perl栈资源回收
CALLFUN_END;
return 0;
}
int main(int argc, char* argv[])
{
char* my_argv[] = {"","ibm.pl"};
printf("begin c_perl_ibm_test\n");
printf("init perl env\n");
initperlenv(2,my_argv);
//标量操作测试
//SV_test();
//函数操作测试
//call_fun();
//操作perl函数返回数组测试
call_fun_ret_array();
destroyperlenv();
printf("leaved c_perl_ibm_test\n");
return 0;
}