PerlInterpreter *p5_init_perl() {
char *embedding[] = { "", "-e", "0" };
int argc = 0;
char **argv;
if (!inited++)
PERL_SYS_INIT(&argc, &argv);
PerlInterpreter *my_perl = perl_alloc();
PERL_SET_CONTEXT(my_perl);
PL_perl_destruct_level = 1;
perl_construct( my_perl );
perl_parse(my_perl, xs_init, 3, embedding, NULL);
PL_exit_flags |= PERL_EXIT_DESTRUCT_END;
perl_run(my_perl);
return my_perl;
}
void *my_Perl_get_context(void) {
PerlInterpreter *my_perl=Perl_get_context();
if (!my_perl) {
my_perl=perl_alloc();
PERL_SET_CONTEXT(my_perl);
perl_construct(my_perl);
perl_parse(my_perl, xs_init, 3, pargs, NULL);
PL_exit_flags |= PERL_EXIT_DESTRUCT_END;
perl_run(my_perl);
PL_thread_at_exit(clear_perl, NULL, 0);
/* warn ("new perl interpreter created %x (thread=%i)",
my_perl,
PL_thread_self()); */
}
return my_perl;
}
void
script_init (int argc, char **argv)
{
#ifdef USE_PERL
char *filename;
perl_env = perl_alloc ();
perl_construct (perl_env);
filename = gethome_conf_file ("script.pl");
script_load (filename, SCRIPT_PERL);
#endif
#ifdef USE_GUILE
gh_enter (argc, argv, fake_main);
#endif
}
int
perl_main(int argc, char **argv, char **env)
{
int r;
iperl = perl_alloc();
perl_construct(iperl);
perl_parse(iperl, xs_init, argc, argv, (char **)NULL);
r = perl_run(iperl);
PerlIO_flush(PerlIO_stdout());
PerlIO_flush(PerlIO_stderr());
perl_destruct(iperl);
perl_free(iperl);
return (r);
}
static void
plperl_init_interp(void)
{
static char *embedding[3] = {
"", "-e", PERLBOOT
};
plperl_interp = perl_alloc();
if (!plperl_interp)
elog(ERROR, "could not allocate Perl interpreter");
perl_construct(plperl_interp);
perl_parse(plperl_interp, plperl_init_shared_libs, 3, embedding, NULL);
perl_run(plperl_interp);
plperl_proc_hash = newHV();
}
static PerlInterpreter *
start_perl_interpreter (char *err, int max_len)
{
PerlInterpreter *intrp;
char *embedding[3];
#ifdef MY_ENV
char *envp[] = {
NULL
};
#else
char **envp = NULL;
#endif
embedding[0] = "CGI";
embedding[1] = "-e";
embedding[2] = virt_handler;
log_debug ("start_perl_interpreter");
if (NULL == (intrp = perl_alloc()))
{
SET_ERR ("Unable to allocate perl interpreter");
return NULL;
}
{
dTHX;
perl_construct(intrp);
PERL_SET_CONTEXT(intrp);
if (0 == perl_parse(intrp, xs_init, 3, embedding, envp))
{
PERL_SET_CONTEXT(intrp);
if (0 == perl_run(intrp))
return intrp;
else
SET_ERR ("Unable to run the perl interpreter");
}
else
SET_ERR ("Unable to parse virt_handler.pl");
#ifdef PERL_EXIT_DESTRUCT_END
PL_exit_flags |= PERL_EXIT_DESTRUCT_END;
#endif
perl_destruct (intrp);
perl_free (intrp);
}
return NULL;
}
/*
* Initialize the perl interpreter.
* This might later be used to reinit the module.
*/
PerlInterpreter *parser_init(void) {
int argc = 0;
char *argv[9];
PerlInterpreter *new_perl = NULL;
int modpathset = 0;
new_perl = perl_alloc();
if (!new_perl) {
LM_ERR("could not allocate perl.\n");
return NULL;
}
perl_construct(new_perl);
argv[0] = ""; argc++; /* First param _needs_ to be empty */
/* Possible Include path extension by modparam */
if (modpath && (strlen(modpath) > 0)) {
modpathset = argc;
LM_INFO("setting lib path: '%s'\n", modpath);
argv[argc] = pkg_malloc(strlen(modpath)+20);
sprintf(argv[argc], "-I%s", modpath);
argc++;
}
argv[argc] = "-M"DEFAULTMODULE; argc++; /* Always "use" Opensips.pm */
argv[argc] = filename; /* The script itself */
argc++;
if (perl_parse(new_perl, xs_init, argc, argv, NULL)) {
LM_ERR("failed to load perl file \"%s\".\n", argv[argc-1]);
if (modpathset) pkg_free(argv[modpathset]);
return NULL;
} else {
LM_INFO("successfully loaded perl file \"%s\"\n", argv[argc-1]);
}
if (modpathset) pkg_free(argv[modpathset]);
perl_run(new_perl);
return new_perl;
}
PerlInterpreter *uwsgi_perl_new_interpreter(void) {
PerlInterpreter *pi = perl_alloc();
if (!pi) {
uwsgi_log("unable to allocate perl interpreter\n");
return NULL;
}
PERL_SET_CONTEXT(pi);
PL_perl_destruct_level = 2;
PL_origalen = 1;
perl_construct(pi);
// over-engeneering
PL_origalen = 1;
return pi;
}
static void
PurlInit()
{
PL_origalen = 1;
dummy_argv = malloc(sizeof(char*) * 3);
dummy_argv[0] = "purl";
dummy_argv[1] = "-e";
dummy_argv[2] = "0";
PERL_SYS_INIT3(&dummy_argc,&dummy_argv,&dummy_env);
my_perl = perl_alloc();
perl_construct(my_perl);
PL_exit_flags |= PERL_EXIT_DESTRUCT_END;
perl_parse(my_perl, xs_init, dummy_argc, dummy_argv, (char **)NULL);
//perl_run(my_perl);
}
main (int argc, char **argv, char **env)
{
char *embedding[] = { "", "-e", "0" };
char *text, **match_list;
int num_matches, i;
int j;
my_perl = perl_alloc();
perl_construct( my_perl );
perl_parse(my_perl, NULL, 3, embedding, NULL);
text = (char *) malloc(sizeof(char) * 486); /** A long string follows! **/
sprintf(text, "%s", "When he is at a convenience store and the bill comes to some amount like 76 cents, Maynard is aware that there is something he *should* do, something that will enable him to get back a quarter, but he has no idea *what*. He fumbles through his red squeezey changepurse and gives the boy three extra pennies with his dollar, hoping that he might luck into the correct amount. The boy gives him back two of his own pennies and then the big shiny quarter that is his prize. -RICHH");
if (match(text, "m/quarter/")) /** Does text contain 'quarter'? **/
printf("match: Text contains the word 'quarter'.\n\n");
else
printf("match: Text doesn't contain the word 'quarter'.\n\n");
if (match(text, "m/eighth/")) /** Does text contain 'eighth'? **/
printf("match: Text contains the word 'eighth'.\n\n");
else
printf("match: Text doesn't contain the word 'eighth'.\n\n");
/** Match all occurrences of /wi../ **/
num_matches = matches(text, "m/(wi..)/g", &match_list);
printf("matches: m/(wi..)/g found %d matches...\n", num_matches);
for (i = 0; i < num_matches; i++)
printf("match: %s\n", match_list[i]);
printf("\n");
for (i = 0; i < num_matches; i++) {
free(match_list[i]);
}
free(match_list);
/** Remove all vowels from text **/
num_matches = substitute(&text, "s/[aeiou]//gi");
if (num_matches) {
printf("substitute: s/[aeiou]//gi...%d substitutions made.\n",
num_matches);
printf("Now text is: %s\n\n", text);
}
/** Attempt a substitution **/
if (!substitute(&text, "s/Perl/C/")) {
printf("substitute: s/Perl/C...No substitution made.\n\n");
}
free(text);
perl_destruct(my_perl);
perl_free(my_perl);
}
bool KviPerlInterpreter::init()
{
if(m_pInterpreter)done();
const char * daArgs[] = { "yo", "-e", "0", "-w" };
m_pInterpreter = perl_alloc();
if(!m_pInterpreter)return false;
PERL_SET_CONTEXT(m_pInterpreter);
PL_perl_destruct_level = 1;
perl_construct(m_pInterpreter);
perl_parse(m_pInterpreter,xs_init,4,(char **)daArgs,NULL);
QString szInitCode;
// this part of the code seems to be unnecessary
// even if it is created by the perl make process...
// "our %EXPORT_TAGS = ('all' => [qw(echo)]);\n"
// "our @EXPORT_OK = (qw(echo));\n"
// "our @EXPORT = qw();\n"
// This is probably needed only if perl has to load
// the XS through XSLoader ?
// Maybe also the remaining part of the package
// declaration could be dropped as well...
// I just haven't tried :D
szInitCode = QString(
"{\n" \
"package KVIrc;\n" \
"require Exporter;\n" \
"our @ISA = qw(Exporter);\n" \
"1;\n" \
"}\n" \
"$g_szContext = \"%1\";\n" \
"$g_bExecuteQuiet = 0;\n" \
"$SIG{__WARN__} = sub\n" \
"{\n" \
" my($p,$f,$l,$x);\n" \
" ($p,$f,$l) = caller;\n" \
" KVIrc::internalWarning(\"At line \".$l.\" of perl code: \");\n" \
" KVIrc::internalWarning(join(' ',@_));\n" \
"}\n").arg(m_szContextName);
eval_pv(szInitCode.toUtf8().data(),false);
return true;
}
int proxenet_perl_initialize_vm(plugin_t* plugin)
{
interpreter_t *interpreter;
char *perl_args[] = { "", "/dev/null", NULL };
int perl_args_count = 2;
#ifdef PERL_SYS_INIT3
int a;
char **perl_args_local;
char *perl_env[] = {};
a = perl_args_count;
perl_args_local = perl_args;
(void) perl_env;
PERL_SYS_INIT3 (&a, (char ***)&perl_args_local, (char ***)&perl_env);
#endif
interpreter = plugin->interpreter;
/* checks */
if (interpreter->ready)
return 0;
#ifdef DEBUG
xlog_perl(LOG_DEBUG, "%s\n", "Initializing VM");
#endif
/* vm init */
my_perl = perl_alloc();
perl_construct(my_perl);
PL_exit_flags |= PERL_EXIT_DESTRUCT_END;
if (!my_perl) {
xlog_perl(LOG_ERROR, "%s\n", "failed init-ing vm");
return -1;
}
perl_parse(my_perl, NULL, perl_args_count, perl_args, (char **)NULL);
interpreter->vm = (void*) my_perl;
interpreter->ready = true;
return 0;
}
void
maybe_source_perl_startup(void)
{
const char *embedargs[] = { "", "" };
const char *perl_init_file = netsnmp_ds_get_string(NETSNMP_DS_APPLICATION_ID,
NETSNMP_DS_AGENT_PERL_INIT_FILE);
char init_file[SNMP_MAXBUF];
static int have_done_init = 0;
if (have_done_init)
return;
have_done_init = 1;
if (!perl_init_file) {
snprintf(init_file, sizeof(init_file) - 1,
"%s/%s", SNMPSHAREPATH, "snmp_perl.pl");
perl_init_file = init_file;
}
embedargs[1] = perl_init_file;
DEBUGMSGTL(("perl", "initializing perl (%s)\n", embedargs[1]));
my_perl = perl_alloc();
if (!my_perl)
goto bail_out;
perl_construct(my_perl);
if (perl_parse(my_perl, xs_init, 2, (char **) embedargs, NULL))
goto bail_out;
if (perl_run(my_perl))
goto bail_out;
DEBUGMSGTL(("perl", "done initializing perl\n"));
return;
bail_out:
snmp_log(LOG_ERR, "embedded perl support failed to initalize\n");
netsnmp_ds_set_boolean(NETSNMP_DS_APPLICATION_ID,
NETSNMP_DS_AGENT_DISABLE_PERL, 1);
return;
}
int perl_init(){
int myargc=0;
char **myenv = NULL;
char **myargv = NULL;
char *embedding[]={"","-e","0"};
PERL_SYS_INIT3(&myargc, &myargv, &myenv);
my_perl=perl_alloc();
sv=NEWSV(1099,0);
perl_construct(my_perl);
PL_exit_flags |= PERL_EXIT_DESTRUCT_END;
perl_parse(my_perl, NULL, 3, embedding, NULL);
perl_run(my_perl);
return 1;
}
PerlInterpreter *
new_perl(void)
{
PerlInterpreter *p;
char *embedding[] = { "", "-mPython::Object", "-e", "$| = 1;", NULL };
p = perl_alloc();
#if 0
fprintf(stderr, "creating new perl %p\n", p); fflush(stderr);
#endif
perl_construct(p);
#ifdef BOOT_FROM_PERL
perl_parse(p, 0, 4, embedding, NULL);
#else
perl_parse(p, xs_init, 4, embedding, NULL);
#endif
perl_run(p);
return p;
}
void module_init(VCSI_CONTEXT vc) {
/* create the perl environment */
char *embedding[] = {"","-e","0"};
perl_embed = perl_alloc();
perl_construct(perl_embed);
perl_parse(perl_embed,NULL,3,embedding,NULL);
/* register the proc */
set_int_proc(vc,"perl-eval",PROC1,perl_eval);
set_int_proc(vc,"perl-func",PROCOPT,perl_func);
set_int_proc(vc,"perl-sc-var",PROC1,perl_sc_var);
/* if ever we destroyed */
/*
perl_destruct(perl_embed);
perl_free(perl_embed);
*/
}
void
init_perl(struct module *module)
{
/* FIXME: it seems that some systems like OS/2 requires PERL_SYS_INIT3
* and PERL_SYS_TERM to open/close the same block, at least regarding
* some ml messages.
*
* Is passing @environ strictly needed ? --Zas */
/* PERL_SYS_INIT3 may not be defined, it depends on the system. */
#ifdef PERL_SYS_INIT3
char *my_argvec[] = { NULL, NULL };
char **my_argv = my_argvec;
int my_argc = 0;
/* A hack to prevent unused variables warnings. */
my_argv[my_argc++] = "";
PERL_SYS_INIT3(&my_argc, &my_argv, &environ);
#endif
my_perl = perl_alloc();
if (my_perl) {
char *hook_global = get_global_hook_file();
char *hook_local = get_local_hook_file();
char *global_argv[] = { "", hook_global};
char *local_argv[] = { "", hook_local};
int err = 1;
perl_construct(my_perl);
if (hook_local)
err = perl_parse(my_perl, NULL, 2, local_argv, NULL);
else if (hook_global)
err = perl_parse(my_perl, NULL, 2, global_argv, NULL);
#ifdef PERL_EXIT_DESTRUCT_END
PL_exit_flags |= PERL_EXIT_DESTRUCT_END;
#endif
if (!err) err = perl_run(my_perl);
if (err) precleanup_perl(module);
}
}
void perl_embed_init(char **incl_path, int cache_perl_files) {
static int is_initialized = 0;
if (is_initialized) {
fprintf(stderr, "perl_embed_init has already been initialized, ignoring call.\n");
return;
}
is_initialized = 1;
int incl_n = _chararray_size(incl_path);
perl_opt_cache = cache_perl_files;
char sdlib_arg[512];
snprintf(sdlib_arg, sizeof sdlib_arg, "-Mblib=%s", bfile(SD_CRAWL_LIB_PATH));
//char *perl_argv[] = { "", blib, "-I", bfile("crawlers/Modules/"), bfile2("perl/persistent.pl"), NULL };
char *perl_argv[incl_n ? incl_n + 4 : 3];
int perl_argc = 0;
perl_argv[perl_argc++] = "";
if (incl_n) {
perl_argv[perl_argc++] = "-I";
int i;
for (i = 0; i < incl_n; i++)
perl_argv[perl_argc++] = incl_path[i];
}
perl_argv[perl_argc++] = sdlib_arg;
perl_argv[perl_argc++] = bfile(PERSISTENT_PATH);
perl_argv[perl_argc] = NULL;
extern char **environ;
PERL_SYS_INIT3(&argc, &argv, &environ);
my_perl = perl_alloc();
perl_construct(my_perl);
//int j = 0;
//while (perl_argv[j++] != NULL)
//printf("perl argument %s\n", perl_argv[j]);
perl_parse(my_perl, xs_init, perl_argc, perl_argv, NULL);
PL_exit_flags |= PERL_EXIT_DESTRUCT_END;
}
/*
* Start trace script
*/
static int perl_start_script(const char *script, int argc, const char **argv)
{
const char **command_line;
int i, err = 0;
command_line = malloc((argc + 2) * sizeof(const char *));
command_line[0] = "";
command_line[1] = script;
for (i = 2; i < argc + 2; i++)
command_line[i] = argv[i - 2];
my_perl = perl_alloc();
perl_construct(my_perl);
if (perl_parse(my_perl, xs_init, argc + 2, (char **)command_line,
(char **)NULL)) {
err = -1;
goto error;
}
if (perl_run(my_perl)) {
err = -1;
goto error;
}
if (SvTRUE(ERRSV)) {
err = -1;
goto error;
}
run_start_sub();
free(command_line);
fprintf(stderr, "perf trace started with Perl script %s\n\n", script);
return 0;
error:
perl_free(my_perl);
free(command_line);
return err;
}
/* Stopping has one big memory leak right now, so it's not used. */
void perlstartstop (int startnotstop) {
if (startnotstop && !isperlrunning) {
char *embedding[] = {
"", "-e",
"$SIG{__DIE__}=$SIG{__WARN__}=\\&EPIC::yell;"
};
++isperlrunning;
my_perl = perl_alloc();
perl_construct( my_perl );
perl_parse(my_perl, xs_init, 3, embedding, NULL);
if (SvTRUE(ERRSV)) yell("perl_parse: %s", SvPV_nolen(ERRSV));
perl_run(my_perl);
if (SvTRUE(ERRSV)) yell("perl_run: %s", SvPV_nolen(ERRSV));
} else if (!startnotstop && isperlrunning && !perlcalldepth) {
perl_destruct(my_perl);
if (SvTRUE(ERRSV)) yell("perl_destruct: %s", SvPV_nolen(ERRSV));
perl_free(my_perl);
if (SvTRUE(ERRSV)) yell("perl_free: %s", SvPV_nolen(ERRSV));
isperlrunning=0;
}
}
uschar *
init_perl(uschar *startup_code)
{
static int argc = 2;
static char *argv[3] = { "exim-perl", "/dev/null", 0 };
SV *sv;
STRLEN len;
if (interp_perl) return 0;
interp_perl = perl_alloc();
perl_construct(interp_perl);
perl_parse(interp_perl, xs_init, argc, argv, 0);
perl_run(interp_perl);
{
dSP;
/*********************************************************************/
/* These lines by PH added to make "warn" output go to the Exim log; I
hope this doesn't break anything. */
sv = newSVpv(
"$SIG{__WARN__} = sub { my($s) = $_[0];"
"$s =~ s/\\n$//;"
"Exim::log_write($s) };", 0);
PUSHMARK(SP);
perl_eval_sv(sv, G_SCALAR|G_DISCARD|G_KEEPERR);
SvREFCNT_dec(sv);
if (SvTRUE(ERRSV)) return US SvPV(ERRSV, len);
/*********************************************************************/
sv = newSVpv(CS startup_code, 0);
PUSHMARK(SP);
perl_eval_sv(sv, G_SCALAR|G_DISCARD|G_KEEPERR);
SvREFCNT_dec(sv);
if (SvTRUE(ERRSV)) return US SvPV(ERRSV, len);
setlocale(LC_ALL, "C"); /* In case it got changed */
return NULL;
}
}
static int pl_perl_init_perl(void) {
static char *my_argv[4] = { "", "-I" ICES_MODULEDIR, "-e", NULL };
static char module_space[255];
if ((my_perl = perl_alloc()) == NULL) {
ices_log_debug("perl_alloc() error: (no memory!)");
return -1;
}
snprintf(module_space, sizeof(module_space), "use %s",
ices_config.pm.module);
my_argv[3] = module_space;
perl_construct(my_perl);
ices_log_debug("Importing perl module: %s", my_argv[3] + 4);
if (perl_parse(my_perl, xs_init, 4, my_argv, NULL)) {
ices_log_debug("perl_parse() error: parse problem");
return -1;
}
if (!(pl_init_hook = pl_find_func("ices_init")))
pl_init_hook = pl_find_func("ices_perl_initialize");
if (!(pl_shutdown_hook = pl_find_func("ices_shutdown")))
pl_shutdown_hook = pl_find_func("ices_perl_shutdown");
if (!(pl_get_next_hook = pl_find_func("ices_get_next")))
pl_get_next_hook = pl_find_func("ices_perl_get_next");
if (!(pl_get_metadata_hook = pl_find_func("ices_get_metadata")))
pl_get_metadata_hook = pl_find_func("ices_perl_get_metadata");
if (!(pl_get_lineno_hook = pl_find_func("ices_get_lineno")))
pl_get_lineno_hook = pl_find_func("ices_perl_get_current_lineno");
if (!pl_get_next_hook) {
ices_log_error("The playlist module must define at least the ices_get_next method");
return -1;
}
return 0;
}
int main(int argc, char **argv){
struct stat sb;
char *buf,*last;
FILE *fp;
fp=fopen(argv[argc-1],"r");
if(!fp)return fprintf(stderr,"unable to open file `%s'\n",argv[argc-1]);
strcpy(argv[argc-1],"-e0");//filename should be long enough :P
fstat(fileno(fp),&sb);
last=buf=malloc(sb.st_size+1);
if(!buf)return fprintf(stderr,"unable to malloc %d bytes\n",sb.st_size+1);
fread(buf,1,sb.st_size,fp);
buf[sb.st_size]=0;
my_perl = perl_alloc();
perl_construct(my_perl);
perl_parse(my_perl, NULL, argc, argv, NULL);
perl_run(my_perl);
for(;*buf;buf++){
if(*buf=='<'&&buf[1]==TAG){
*buf=0;
fputs(last,stdout);
last=buf+=2;
for(;*buf;buf++){
if(*buf==TAG&&buf[1]=='>'){
*buf=0;
eval_pv(last,TRUE);
last=buf+=2;
break;
}
}
if(!buf){
eval_pv(last,TRUE);
break;
}
}
}
fputs(last,stdout);
perl_destruct(my_perl);
perl_free(my_perl);
}
PerlInterpreter *p5_init_perl(
int argc,
char **argv,
SV *(*call_p6_method)(IV, char * , I32, SV *, SV **),
SV *(*call_p6_callable)(IV, SV *, SV **),
void (*free_p6_object)(IV),
SV *(*hash_at_key)(IV, char *),
SV *(*hash_assign_key)(IV, char *, SV *)
) {
if (inited) {
#ifndef MULTIPLICITY
return NULL;
#endif
}
else {
inited = 1;
PERL_SYS_INIT(&argc, &argv);
}
interpreters++;
PerlInterpreter *my_perl = perl_alloc();
PERL_SET_CONTEXT(my_perl);
PL_perl_destruct_level = 1;
perl_construct( my_perl );
perl_parse(my_perl, xs_init, argc, argv, NULL);
PL_exit_flags |= PERL_EXIT_DESTRUCT_END;
perl_run(my_perl);
p5_init_callbacks(
call_p6_method,
call_p6_callable,
free_p6_object,
hash_at_key,
hash_assign_key
);
return my_perl;
}
/***********************************************************************************************************************************
Initialize Perl
***********************************************************************************************************************************/
static void
perlInit(void)
{
FUNCTION_TEST_VOID();
if (!my_perl)
{
// Initialize Perl with dummy args and environment
int argc = 1;
const char *argv[1] = {strPtr(cfgExe())};
const char *env[1] = {NULL};
PERL_SYS_INIT3(&argc, (char ***)&argv, (char ***)&env);
// Create the interpreter
const char *embedding[] = {"", "-e", "0"};
my_perl = perl_alloc();
perl_construct(my_perl);
// Don't let $0 assignment update the proctitle or embedding[0]
PL_origalen = 1;
// Start the interpreter
perl_parse(my_perl, xs_init, 3, (char **)embedding, NULL);
PL_exit_flags |= PERL_EXIT_DESTRUCT_END;
perl_run(my_perl);
// Use customer loader to get all embedded modules
eval_pv("splice(@INC, 0, 0, " LOADER_SUB ");", true);
// Now that the custom loader is installed, load the main module;
eval_pv("use " PGBACKREST_MODULE ";", true);
// Set config data -- this is done separately to avoid it being included in stack traces
perlEval(strNewFmt(PGBACKREST_MAIN "ConfigSet('%s', '%s')", strPtr(cfgExe()), strPtr(perlOptionJson())));
}
FUNCTION_TEST_RETURN_VOID();
}
static int
perl_code ( HBArgs *d )
{
char *em[] = { "", "-e", "0" };
char *code;
int code_f;
int retval;
if (!d->sym->arg(d, NULL, &code, NULL, &code_f))
return 0;
if (!code)
return 1;
pthread_mutex_lock(&perl_mutex);
perl_int = perl_alloc();
perl_construct(perl_int);
perl_parse(perl_int, xs_init, 3, em, NULL);
perl_run(perl_int);
perl_eval_pv("use HB;", TRUE);
retval = hbm_perl_exec(d, code);
perl_destruct(perl_int);
perl_free(perl_int);
pthread_mutex_unlock(&perl_mutex);
if (code_f)
free(code);
return retval;
}
int main(int argc, char * argv[])
{
PerlInterpreter *my_perl;
my_perl = perl_alloc();
perl_construct( my_perl );
char pzObjectAndPath[512];
sprintf(pzObjectAndPath,"%s%s",(const char *)"C:\\Users\\Brian\\Desktop\\XMLFoundation\\Examples\\Perl\\","PerlTest.pl");
// sprintf(pzObjectAndPath,"%s%s",(const char *)"/home/ubt/Desktop/XMLFoundation/Examples/Perl/","PerlTest.pl");
char *pzPerlFileArg[] = { "", pzObjectAndPath };
// parse the Perl Script
perl_parse(my_perl, 0, 2, pzPerlFileArg, (char **)NULL);
char *args[] = { NULL };
perl_call_argv("showtime", G_DISCARD | G_NOARGS, args);
perl_destruct(my_perl);
perl_free(my_perl);
return 0;
}
int proxenet_perl_initialize_vm(plugin_t* plugin)
{
interpreter_t *interpreter;
interpreter = plugin->interpreter;
/* In order to perl_parse nothing */
char *args[2] = {
"",
"/dev/null"
};
/* checks */
if (!interpreter->ready){
#ifdef DEBUG
xlog(LOG_DEBUG, "[Perl] %s\n", "Initializing VM");
#endif
/* vm init */
my_perl = perl_alloc();
perl_construct(my_perl);
PL_exit_flags |= PERL_EXIT_DESTRUCT_END;
if (!my_perl) {
xlog(LOG_ERROR, "[Perl] %s\n", "failed init-ing vm");
return -1;
}
interpreter->vm = (void*) my_perl;
interpreter->ready = true;
perl_parse(my_perl, NULL, 2, args, (char **)NULL);
}
return proxenet_perl_load_file(plugin);
}
int
perl_reinit()
{
int myargc=0;
char **myenv = NULL;
char **myargv = NULL;
char *embedding1[]={"","-e","0"};
if(my_perl) {
return 0;
}
// PERL_SYS_INIT3(&myargc, &myargv, &myenv);
my_perl=perl_alloc();
sv=NEWSV(1099,0);
perl_construct(my_perl);
// PL_exit_flags |= PERL_EXIT_DESTRUCT_END;
PL_perl_destruct_level = 2;
perl_parse(my_perl, NULL, 3, embedding1, NULL);
perl_run(my_perl);
return 1;
}
static void
_perl_thread_init(LogThrDestDriver *d)
{
PerlDestDriver *self = (PerlDestDriver *)d;
PerlInterpreter *my_perl;
char *argv[] = { "syslog-ng", self->filename };
self->perl = perl_alloc();
perl_construct(self->perl);
my_perl = self->perl;
PL_exit_flags |= PERL_EXIT_DESTRUCT_END;
perl_parse(self->perl, xs_init, 2, (char **)argv, NULL);
if (!self->queue_func_name)
self->queue_func_name = g_strdup("queue");
if (self->init_func_name)
_call_perl_function_with_no_arguments(self, self->init_func_name);
msg_verbose("Initializing Perl destination",
evt_tag_str("driver", self->super.super.super.id),
evt_tag_str("script", self->filename),
NULL);
}
