/****************************embperl.c***********************************/
#include <stdlib.h>
#include "EXTERN.h"
#include "perl.h"
#include "embperl.h"
#ifdef _SCO_UNIX
#define SCO_BEGIN {
#define SCO_END }
#else
#define SCO_BEGIN
#define SCO_END
#endif
extern void xs_init (pTHX);
static void set_out_arg(SV* sv, char *out_arg);
static char g_result_area[MAX_RESULT_NUM][MAX_RESULT_LEN];
static PRESULT g_result;
static PerlInterpreter *my_perl;
int init_perl(const char *PLname)
{
int i;
int exitstatus;
char *dummyargs[] = {"", "-e", "0" };
char *PLargv[] = {"", NULL};
PLargv[1] = (char *)PLname;
my_perl = perl_alloc();
perl_construct(my_perl);
if (PLname == NULL || strlen(PLname) == 0)
exitstatus = perl_parse(my_perl, xs_init, 3, dummyargs, NULL);
else
exitstatus = perl_parse(my_perl, xs_init, 2, PLargv, NULL);
#ifndef _SCO_UNIX
PL_exit_flags |= PERL_EXIT_DESTRUCT_END;
#else
if (!exitstatus && PLname != NULL && strlen(PLname) > 0)
exitstatus = perl_run(my_perl);
#endif
for (i = 0; i < MAX_RESULT_NUM; i++)
g_result.r_ary = g_result_area;
g_result.nums = 0;
if (exitstatus) final_perl();
return exitstatus;
}
void final_perl()
{
memset(&g_result, 0, sizeof(g_result));
perl_destruct(my_perl);
perl_free(my_perl);
}
/* perl 脚本解析器
输入:
script 脚本内容
argc 输入参数个数
argv 传送给脚本的参数
返回:
脚本的返回值
*/
PRESULT* ebperl_argv(const char *script, int argc, char* argv[])
{
int n, i;
SV* sv;
SV *command;
char *subroutine;
STRLEN len;
char errmsg[256];
subroutine = calloc(1, strlen(script) + 32);
sprintf(subroutine, "sub {%s}", script);
printf("begin perl_eval_pv\n");
command = perl_eval_pv(subroutine, 1);
if (SvTRUE(ERRSV))
{
strcpy(errmsg, SvPV(ERRSV, len));
printf("perl_eval_pv err[%s]\n", errmsg);
free(subroutine);
return NULL;
}
free(subroutine);
SCO_BEGIN
dSP;
ENTER;
SAVETMPS;
PUSHMARK(sp);
for (i = 0; i < argc; i++)
{
XPUSHs(sv_2mortal(newSVpv(argv, 0)));
}
PUTBACK;
printf("begin perl_call_sv\n");
n = perl_call_sv(command, G_ARRAY|G_EVAL);
printf("end call\n");
if (SvTRUE(ERRSV))
{
strcpy(errmsg, SvPV(ERRSV, len));
printf("n = %d perl_call_sv err--%s", n, errmsg);
n = 0;
}
SPAGAIN;
g_result.nums = n;
while (n-- > 0)
{
sv = POPs;
set_out_arg(sv, g_result.r_ary[n]);
}
PUTBACK;
FREETMPS;
LEAVE;
SCO_END
return &g_result;
}
static void set_out_arg(SV* sv, char *out_arg)
{
STRLEN len;
switch (SvTYPE(sv))
{
case SVt_IV: /* 1 */
case SVt_PVIV: /* 5 */
sprintf(out_arg, "%d", SvIV(sv));
break;
case SVt_NV: /* 2 */
case SVt_PVNV: /* 6 */
sprintf(out_arg, "%lf", SvNV(sv));
break;
case SVt_RV: /* 3 */
if (SvROK(sv))
{
set_out_arg(SvRV(sv), out_arg);
}
else
sv_dump(sv);
break;
case SVt_PV: /* 4 */
case SVt_PVMG: /* 7 */
snprintf(out_arg, MAX_RESULT_LEN, "%s", SvPV(sv, len));
break;
case SVt_PVBM: /* 8 */
case SVt_PVLV: /* 9 */
case SVt_PVAV: /* 10 */
case SVt_PVHV: /* 11 */
case SVt_PVCV: /* 12 */
case SVt_PVGV: /* 13 */
case SVt_PVFM: /* 14 */
case SVt_PVIO: /* 15 */
sv_dump(sv);
break;
default:
sv_dump(sv);
break;
}
}