tar包位置：http://m.shnenglu.com/Files/changup/c_perl.tar
本次測試比較完整的一個c文件，貼出來，請高人指點(diǎn)完善，爭取大家實(shí)際中能用好，畢竟感覺在程序中嵌入解釋性的腳本是非常好的，尤其針對復(fù)雜多變的業(yè)務(wù)邏輯部分；
#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標(biāo)量的操作
*/
void SV_test()
{
//創(chuàng)建
SV* sv_i = newSViv(99);
SV* sv_n = newSVnv(23.45);
SV* sv_p = newSVpv("test string",0);
SV* funstring = 0;
//將變量設(shè)置為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));
//以優(yōu)美的格式打印標(biāo)量
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函數(shù)
sub fun1()
{
$username = shift;
$arg = shift;
print "your name=$username,your arg=$arg\n";
return 88;
}
*/
int call_fun()
{
//調(diào)用函數(shù)前的perl堆棧操作
CALLFUN_BEGIN;
//參數(shù)入棧
XPUSHs(sv_2mortal(newSVpv("changym",0)));
XPUSHs(sv_2mortal(newSViv(32)));
PUTBACK; //表示參數(shù)完了
//調(diào)用函數(shù)
perl_call_pv("fun1",G_SCALAR); //G_SCALAR---返回標(biāo)量;G_ARRAY--返回數(shù)組
/*
#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函數(shù),perl 函數(shù)返回一個數(shù)組
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; //詭異的現(xiàn)象，非要定義這個否則打印值的哪行就報錯
//ibm.c:162: `n_a' undeclared (first use in this function)
//同樣的問題就是PerlInterpreter的名字必須叫my_perl,為什么啊？
//調(diào)用函數(shù)前的perl堆棧操作
CALLFUN_BEGIN;
PUTBACK; //表示參數(shù)完了
//調(diào)用函數(shù)
ireturn = perl_call_pv("return_array",G_ARRAY); //G_SCALAR---返回標(biāo)量;G_ARRAY--返回數(shù)組
//開始操作返回值了
SPAGAIN;
if(ireturn>0)
{
while(ireturn>0)
{
//返回的順序是數(shù)組的倒敘啊？
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);
//標(biāo)量操作測試
//SV_test();
//函數(shù)操作測試
//call_fun();
//操作perl函數(shù)返回數(shù)組測試
call_fun_ret_array();
destroyperlenv();
printf("leaved c_perl_ibm_test\n");
return 0;
}