src/scripting/perl/core.c

   1 /* Perl scripting engine */
   2
   3 #ifdef HAVE_CONFIG_H
   4 #include "config.h"
   5 #endif
   6
   7 #include <stdio.h>
   8 #include <stdlib.h>
   9
  10 #include "elinks.h"
  11
  12 #include "config/home.h"
  13 #include "main/module.h"
  14 #include "osdep/osdep.h"
  15 #include "scripting/perl/core.h"
  16 #include "util/file.h"
  17
  18 /* The configure script runs "perl -MExtUtils::Embed -e ccopts -e ldopts",
  19  * which should output the location of the DynaLoader.a where this function
  20  * is defined.  This prototype does not appear to be in any public header
  21  * file of Perl.  */
  22 EXTERN_C void boot_DynaLoader (pTHX_ CV* cv);
  23
  24 #define PERL_HOOKS_FILENAME     "hooks.pl"
  25
  26
  27 PerlInterpreter *my_perl;
  28
  29 #ifdef PERL_SYS_INIT3
  30 extern char **environ;
  31 #endif
  32
  33
  34 static char *
  35 get_global_hook_file(void)
  36 {
  37         static char buf[] = CONFDIR STRING_DIR_SEP PERL_HOOKS_FILENAME;
  38
  39         if (file_exists(buf)) return buf;
  40         return NULL;
  41 }
  42
  43 static char *
  44 get_local_hook_file(void)
  45 {
  46         static char buf[1024];  /* TODO: MAX_PATH ??? --Zas */
  47
  48         if (!elinks_home) return NULL;
  49         snprintf(buf, sizeof(buf), "%s%s", elinks_home, PERL_HOOKS_FILENAME);
  50         if (file_exists(buf)) return buf;
  51         return NULL;
  52 }
  53
  54
  55 static void
  56 precleanup_perl(struct module *module)
  57 {
  58         if (!my_perl) return;
  59
  60         perl_destruct(my_perl);
  61         perl_free(my_perl);
  62         my_perl = NULL;
  63 }
  64
  65 void
  66 cleanup_perl(struct module *module)
  67 {
  68         precleanup_perl(module);
  69 #ifdef PERL_SYS_TERM
  70         PERL_SYS_TERM();
  71 #endif
  72 }
  73
  74 /** Tell Perl about XSUBs that were linked into ELinks.  */
  75 static void
  76 xs_init(pTHX)
  77 {
  78         /* DynaLoader is the only Perl module whose library is
  79          * statically linked into ELinks.  DynaLoader::bootstrap will
  80          * then load other libraries and register their XSUBs as
  81          * needed.  */
  82         newXS("DynaLoader::boot_DynaLoader", boot_DynaLoader, __FILE__);
  83 }
  84
  85 void
  86 init_perl(struct module *module)
  87 {
  88         /* FIXME: it seems that some systems like OS/2 requires PERL_SYS_INIT3
  89          * and PERL_SYS_TERM to open/close the same block, at least regarding
  90          * some ml messages.
  91          *
  92          * Is passing @environ strictly needed ? --Zas */
  93
  94         /* PERL_SYS_INIT3 may not be defined, it depends on the system. */
  95 #ifdef PERL_SYS_INIT3
  96         char *my_argvec[] = { NULL, NULL };
  97         char **my_argv = my_argvec;
  98         int my_argc = 0;
  99
 100         /* A hack to prevent unused variables warnings. */
 101         my_argv[my_argc++] = "";
 102
 103         PERL_SYS_INIT3(&my_argc, &my_argv, &environ);
 104 #endif
 105
 106         my_perl = perl_alloc();
 107         if (my_perl) {
 108                 char *hook_global = get_global_hook_file();
 109                 char *hook_local = get_local_hook_file();
 110                 char *global_argv[] = { "", hook_global};
 111                 char *local_argv[] = { "", hook_local};
 112                 int err = 1;
 113
 114                 perl_construct(my_perl);
 115                 if (hook_local)
 116                         err = perl_parse(my_perl, xs_init, 2, local_argv, NULL);
 117                 else if (hook_global)
 118                         err = perl_parse(my_perl, xs_init, 2, global_argv, NULL);
 119 #ifdef PERL_EXIT_DESTRUCT_END
 120                 PL_exit_flags |= PERL_EXIT_DESTRUCT_END;
 121 #endif
 122                 if (!err) err = perl_run(my_perl);
 123                 if (err) precleanup_perl(module);
 124         }
 125 }