鏈嫻嬭瘯姣旇緝瀹屾暣鐨勪竴涓猚鏂囦歡錛岃創(chuàng)鍑烘潵錛岃楂樹(shù)漢鎸囩偣瀹屽杽錛屼簤鍙栧ぇ瀹跺疄闄呬腑鑳界敤濂斤紝姣曠珶鎰熻鍦ㄧ▼搴忎腑宓屽叆瑙ｉ噴鎬х殑鑴氭湰鏄潪甯稿ソ鐨勶紝灝ゅ叾閽堝澶嶆潅澶氬彉鐨勪笟鍔￠昏緫閮ㄥ垎錛?br>
#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);
}
/* 鏅歱erl鏍囬噺鐨勬搷浣?br>*/
void SV_test()
{
//鍒涘緩
SV* sv_i = newSViv(99);
SV* sv_n = newSVnv(23.45);
SV* sv_p = newSVpv("test string",0);
SV* funstring = 0;
//灝嗗彉閲忚緗負(fù)mortal錛?/span>
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);
//淇敼鍊?/span>
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); //娌℃湁寰楀埌鍊?/span>
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; //琛ㄧず鍙傛暟瀹屼簡(jiǎn)
//璋冪敤鍑芥暟
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. */
//寮濮嬫搷浣滆繑鍥炲間簡(jiǎn)
SPAGAIN;
printf("inner ibm.pl,fun1 return %s\n",POPp); //POPi---int, POPp--pchar
PUTBACK; //琛ㄧず榪斿洖鍊煎彇瀹屼簡(jiǎn)
//perl鏍堣祫婧愬洖鏀?/span>
CALLFUN_END;
return 0;
}
/* 鎿嶄綔perl鍑芥暟,perl 鍑芥暟榪斿洖涓涓暟緇?br>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; //璇″紓鐨勭幇璞★紝闈炶瀹氫箟榪欎釜鍚﹀垯鎵撳嵃鍊肩殑鍝灝辨姤閿?br> //ibm.c:162: `n_a' undeclared (first use in this function)
//鍚屾牱鐨勯棶棰樺氨鏄疨erlInterpreter鐨勫悕瀛楀繀欏誨彨my_perl,涓轟粈涔堝晩錛?br> //璋冪敤鍑芥暟鍓嶇殑perl鍫嗘爤鎿嶄綔
CALLFUN_BEGIN;
PUTBACK; //琛ㄧず鍙傛暟瀹屼簡(jiǎn)
//璋冪敤鍑芥暟
ireturn = perl_call_pv("return_array",G_ARRAY); //G_SCALAR---榪斿洖鏍囬噺;G_ARRAY--榪斿洖鏁扮粍
//寮濮嬫搷浣滆繑鍥炲間簡(jiǎn)
SPAGAIN;
if(ireturn>0)
{
while(ireturn>0)
{
//榪斿洖鐨勯『搴忔槸鏁扮粍鐨勫掑彊鍟婏紵
printf("coming from ibm.pl.return_array:%d-%s\n",ireturn--,POPpx);
}
}
PUTBACK; //琛ㄧず榪斿洖鍊煎彇瀹屼簡(jiǎn)
//perl鏍堣祫婧愬洖鏀?/span>
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;
}
#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);
}
/* 鏅歱erl鏍囬噺鐨勬搷浣?br>*/
void SV_test()
{
//鍒涘緩
SV* sv_i = newSViv(99);
SV* sv_n = newSVnv(23.45);
SV* sv_p = newSVpv("test string",0);
SV* funstring = 0;
//灝嗗彉閲忚緗負(fù)mortal錛?/span>
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);
//淇敼鍊?/span>
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); //娌℃湁寰楀埌鍊?/span>
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; //琛ㄧず鍙傛暟瀹屼簡(jiǎn)
//璋冪敤鍑芥暟
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. */
//寮濮嬫搷浣滆繑鍥炲間簡(jiǎn)
SPAGAIN;
printf("inner ibm.pl,fun1 return %s\n",POPp); //POPi---int, POPp--pchar
PUTBACK; //琛ㄧず榪斿洖鍊煎彇瀹屼簡(jiǎn)
//perl鏍堣祫婧愬洖鏀?/span>
CALLFUN_END;
return 0;
}
/* 鎿嶄綔perl鍑芥暟,perl 鍑芥暟榪斿洖涓涓暟緇?br>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; //璇″紓鐨勭幇璞★紝闈炶瀹氫箟榪欎釜鍚﹀垯鎵撳嵃鍊肩殑鍝灝辨姤閿?br> //ibm.c:162: `n_a' undeclared (first use in this function)
//鍚屾牱鐨勯棶棰樺氨鏄疨erlInterpreter鐨勫悕瀛楀繀欏誨彨my_perl,涓轟粈涔堝晩錛?br> //璋冪敤鍑芥暟鍓嶇殑perl鍫嗘爤鎿嶄綔
CALLFUN_BEGIN;
PUTBACK; //琛ㄧず鍙傛暟瀹屼簡(jiǎn)
//璋冪敤鍑芥暟
ireturn = perl_call_pv("return_array",G_ARRAY); //G_SCALAR---榪斿洖鏍囬噺;G_ARRAY--榪斿洖鏁扮粍
//寮濮嬫搷浣滆繑鍥炲間簡(jiǎn)
SPAGAIN;
if(ireturn>0)
{
while(ireturn>0)
{
//榪斿洖鐨勯『搴忔槸鏁扮粍鐨勫掑彊鍟婏紵
printf("coming from ibm.pl.return_array:%d-%s\n",ireturn--,POPpx);
}
}
PUTBACK; //琛ㄧず榪斿洖鍊煎彇瀹屼簡(jiǎn)
//perl鏍堣祫婧愬洖鏀?/span>
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;
}
]]>
琛ュ厖涓涓嬶細(xì)寮婧愮殑鐜版垚妗嗘灦鏇村ソ錛?/p>
]]>
]]>