/* Perl - Script BASIC extension module
UXLIBS: -lperl
*/
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include <ctype.h>
#include <math.h>
#include <time.h>
#include "../../basext.h"
#include "cbasic.h"
#include <EXTERN.h>
#include <perl.h>
static PerlInterpreter *my_perl;
/****************************
Extension Module Functions
****************************/
besVERSION_NEGOTIATE
RETURN_FUNCTION((int)INTERFACE_VERSION);
besEND
besSUB_START
DIM AS long PTR p;
besMODULEPOINTER = besALLOC(sizeof(long));
IF (besMODULEPOINTER EQ NULL) THEN_DO RETURN_FUNCTION(0);
p = (long PTR)besMODULEPOINTER;
RETURN_FUNCTION(0);
besEND
besSUB_FINISH
DIM AS long PTR p;
p = (long PTR)besMODULEPOINTER;
IF (p EQ NULL) THEN_DO RETURN_FUNCTION(0);
RETURN_FUNCTION(0);
besEND
/****************
Perl Functions
****************/
besFUNCTION(pl_Init)
DIM AS char *embedding[] = { "", "-e", "0" };
my_perl = perl_alloc();
perl_construct(my_perl);
perl_parse(my_perl, NULL, 3, embedding, NULL);
perl_run(my_perl);
besRETURN_LONG(my_perl);
besEND
besFUNCTION(pl_Eval)
DIM AS const char PTR cmdstr;
besARGUMENTS("z")
AT cmdstr
besARGEND
eval_pv(cmdstr, TRUE);
besRETURNVALUE = NULL;
besEND
besFUNCTION(pl_GetInt)
DIM AS const char PTR cmdstr;
DIM AS int rtnval;
besARGUMENTS("z")
AT cmdstr
besARGEND
rtnval = SvIV(get_sv(cmdstr, FALSE));
besRETURN_LONG(rtnval);
besEND
besFUNCTION(pl_GetDbl)
DIM AS const char PTR cmdstr;
DIM AS double rtnval;
besARGUMENTS("z")
AT cmdstr
besARGEND
rtnval = SvNV(get_sv(cmdstr, FALSE));
besRETURN_DOUBLE(rtnval);
besEND
besFUNCTION(pl_GetStr)
DIM AS const char PTR cmdstr;
DIM AS char PTR rtnval;
DIM AS STRLEN n_a;
besARGUMENTS("z")
AT cmdstr
besARGEND
rtnval = SvPV(get_sv(cmdstr, FALSE), n_a);
besRETURN_STRING(rtnval);
besEND
besFUNCTION(pl_Destroy)
perl_destruct(my_perl);
perl_free(my_perl);
besRETURNVALUE = NULL;
besEND