mirror of
https://github.com/rkd77/elinks.git
synced 2024-12-04 14:46:47 -05:00
109 lines
2.1 KiB
C
109 lines
2.1 KiB
C
/* Perl scripting engine */
|
|
|
|
#ifdef HAVE_CONFIG_H
|
|
#include "config.h"
|
|
#endif
|
|
|
|
#include <stdio.h>
|
|
#include <stdlib.h>
|
|
|
|
#include "elinks.h"
|
|
|
|
#include "config/home.h"
|
|
#include "main/module.h"
|
|
#include "osdep/osdep.h"
|
|
#include "scripting/perl/core.h"
|
|
#include "util/file.h"
|
|
|
|
#define PERL_HOOKS_FILENAME "hooks.pl"
|
|
|
|
|
|
PerlInterpreter *my_perl;
|
|
|
|
#ifdef PERL_SYS_INIT3
|
|
extern char **environ;
|
|
#endif
|
|
|
|
|
|
static char *
|
|
get_global_hook_file(void)
|
|
{
|
|
static char buf[] = CONFDIR STRING_DIR_SEP PERL_HOOKS_FILENAME;
|
|
|
|
if (file_exists(buf)) return buf;
|
|
return NULL;
|
|
}
|
|
|
|
static char *
|
|
get_local_hook_file(void)
|
|
{
|
|
static char buf[1024]; /* TODO: MAX_PATH ??? --Zas */
|
|
|
|
if (!elinks_home) return NULL;
|
|
snprintf(buf, sizeof(buf), "%s%s", elinks_home, PERL_HOOKS_FILENAME);
|
|
if (file_exists(buf)) return buf;
|
|
return NULL;
|
|
}
|
|
|
|
|
|
static void
|
|
precleanup_perl(struct module *module)
|
|
{
|
|
if (!my_perl) return;
|
|
|
|
perl_destruct(my_perl);
|
|
perl_free(my_perl);
|
|
my_perl = NULL;
|
|
}
|
|
|
|
void
|
|
cleanup_perl(struct module *module)
|
|
{
|
|
precleanup_perl(module);
|
|
#ifdef PERL_SYS_TERM
|
|
PERL_SYS_TERM();
|
|
#endif
|
|
}
|
|
|
|
|
|
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_argv[] = { NULL };
|
|
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);
|
|
}
|
|
}
|