src/perl-plugin.c

   1 /* vim:tw=78:ts=8:sw=4:set ft=c:  */
   2 /*
   3     Copyright (C) 2007-2011 Ben Kibbey <bjk@luxsci.net>
   4
   5     This program is free software; you can redistribute it and/or modify
   6     it under the terms of the GNU General Public License as published by
   7     the Free Software Foundation; either version 2 of the License, or
   8     (at your option) any later version.
   9
  10     This program is distributed in the hope that it will be useful,
  11     but WITHOUT ANY WARRANTY; without even the implied warranty of
  12     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  13     GNU General Public License for more details.
  14
  15     You should have received a copy of the GNU General Public License
  16     along with this program; if not, write to the Free Software
  17     Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
  18 */
  19 #ifdef HAVE_CONFIG_H
  20 #include <config.h>
  21 #endif
  22
  23 #include <stdio.h>
  24 #include <stdlib.h>
  25 #include <unistd.h>
  26 #include <err.h>
  27 #include <errno.h>
  28 #include <EXTERN.h>
  29 #include <perl.h>
  30
  31 #include "perl-plugin.h"
  32
  33 static PerlInterpreter *my_perl;
  34 static perl_error_func *error_func;
  35
  36 int perl_init_file(const char *filename, perl_error_func *efunc)
  37 {
  38     char *args[] = {"", "-e", "0"};
  39     char *buf;
  40     int argc;
  41     char **argv, **env;
  42
  43     if (my_perl)
  44         return 0;
  45
  46     error_func = efunc;
  47     PERL_SYS_INIT3(&argc, &argv, &env);
  48     my_perl = perl_alloc();
  49     perl_construct(my_perl);
  50     PL_exit_flags |= PERL_EXIT_DESTRUCT_END;
  51     perl_parse(my_perl, NULL, 3, args, NULL);
  52     perl_run(my_perl);
  53
  54     asprintf(&buf, "do \"%s\"", filename);
  55     eval_pv(buf, FALSE);
  56     free(buf);
  57
  58     if (SvTRUE(ERRSV)) {
  59         (*error_func)("%s", SvPV_nolen(ERRSV));
  60         perl_cleanup();
  61         return 1;
  62     }
  63
  64     return 0;
  65 }
  66
  67 int perl_call_sub(const char *str, const char *arg, char **result)
  68 {
  69     int flags = G_EVAL;
  70     int ret = 0;
  71
  72     dSP;
  73     ENTER;
  74     SAVETMPS;
  75     PUSHMARK(SP);
  76
  77     if (arg && *arg) {
  78         XPUSHs(sv_2mortal(newSVpvn(arg, strlen(arg))));
  79         PUTBACK;
  80     }
  81     else
  82         flags |= G_NOARGS;
  83
  84     call_pv(str, flags);
  85
  86     if (SvTRUE(ERRSV)) {
  87         (*error_func)("%s", SvPV_nolen(ERRSV));
  88         ret = 1;
  89     }
  90     else
  91         *result = strdup(POPp);
  92
  93     PUTBACK;
  94     FREETMPS;
  95     LEAVE;
  96     return ret;
  97 }
  98
  99 void perl_cleanup()
 100 {
 101     if (!my_perl)
 102         return;
 103
 104     perl_destruct(my_perl);
 105     perl_free(my_perl);
 106     PERL_SYS_TERM();
 107     my_perl = NULL;
 108     error_func = NULL;
 109 }