1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
|
#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"
#ifdef __CYGWIN__
#include "w32api/basetyps.h"
#endif
/* Include the JNI header file */
#include "jni.h"
/* The PerlInterpreter handle */
PerlInterpreter *interp = NULL ;
/* XS initialisation stuff */
void boot_DynaLoader(pTHX_ CV* cv) ;
static void xs_init(pTHX){
char *file = __FILE__ ;
dXSUB_SYS ;
newXS("DynaLoader::boot_DynaLoader", boot_DynaLoader, file) ;
}
void throw_ijp(JNIEnv *env, char *msg){
jclass ije ;
ije = (*(env))->FindClass(env, "org/perl/inline/java/InlineJavaPerlException") ;
if ((*(env))->ExceptionCheck(env)){
(*(env))->ExceptionDescribe(env) ;
(*(env))->ExceptionClear(env) ;
(*(env))->FatalError(env, "Can't find class InlineJavaPerlException: exiting...") ;
}
(*(env))->ThrowNew(env, ije, msg) ;
}
JNIEXPORT void JNICALL Java_org_perl_inline_java_InlineJavaPerlInterpreter_construct(JNIEnv *env, jclass cls){
char *args[] = {"inline-java", "-e1"} ;
char **envdup = NULL ;
#ifdef PERL_PARSE_ENV_DUP
int envl = 0 ;
int i = 0 ;
/* This will leak, but it's a one shot... */
for (i = 0 ; environ[i] != NULL ; i++){
envl++ ;
}
envdup = (char **)calloc(envl + 1, sizeof(char *)) ;
for (i = 0 ; i < envl ; i++){
envdup[i] = strdup(environ[i]) ;
}
#endif
interp = perl_alloc() ;
perl_construct(interp) ;
perl_parse(interp, xs_init, 2, args, envdup) ;
perl_run(interp) ;
}
JNIEXPORT void JNICALL Java_org_perl_inline_java_InlineJavaPerlInterpreter_destruct(JNIEnv *env, jclass cls){
if (interp != NULL){
perl_destruct(interp) ;
perl_free(interp) ;
interp = NULL ;
}
}
JNIEXPORT void JNICALL Java_org_perl_inline_java_InlineJavaPerlInterpreter_evalNoReturn(JNIEnv *env, jclass cls, jstring code){
SV *sv = NULL ;
char *pcode = NULL ;
pcode = (char *)((*(env))->GetStringUTFChars(env, code, NULL)) ;
sv = sv_2mortal(newSVpv(pcode, 0)) ;
/* sv = eval_pv(pcode, FALSE) ; */
eval_sv(sv, G_EVAL|G_KEEPERR) ;
(*(env))->ReleaseStringUTFChars(env, code, pcode) ;
if (SvTRUE(ERRSV)){
STRLEN n_a ;
throw_ijp(env, SvPV(ERRSV, n_a)) ;
}
}
MODULE = Inline::Java::PerlInterpreter PACKAGE = Inline::Java::PerlInterpreter
PROTOTYPES: DISABLE
|
