src/perl.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.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
  41     if (my_perl)
  42         return 0;
  43
  44     error_func = efunc;
  45     PERL_SYS_INIT3(0, NULL, NULL);
  46     my_perl = perl_alloc();
  47     perl_construct(my_perl);
  48     PL_exit_flags |= PERL_EXIT_DESTRUCT_END;
  49     perl_parse(my_perl, NULL, 3, args, NULL);
  50     perl_run(my_perl);
  51
  52     asprintf(&buf, "do \"%s\"", filename);
  53     eval_pv(buf, FALSE);
  54     free(buf);
  55
  56     if (SvTRUE(ERRSV)) {
  57         (*error_func)("%s", SvPV_nolen(ERRSV));
  58         perl_cleanup();
  59         return 1;
  60     }
  61
  62     return 0;
  63 }
  64
  65 int perl_call_sub(const char *str, const char *arg, char **result)
  66 {
  67     int flags = G_EVAL;
  68     int ret = 0;
  69
  70     dSP;
  71     ENTER;
  72     SAVETMPS;
  73     PUSHMARK(SP);
  74
  75     if (arg && *arg) {
  76         XPUSHs(sv_2mortal(newSVpvn(arg, strlen(arg))));
  77         PUTBACK;
  78     }
  79     else
  80         flags |= G_NOARGS;
  81
  82     call_pv(str, flags);
  83
  84     if (SvTRUE(ERRSV)) {
  85         (*error_func)("%s", SvPV_nolen(ERRSV));
  86         ret = 1;
  87     }
  88     else
  89         *result = strdup(POPp);
  90
  91     PUTBACK;
  92     FREETMPS;
  93     LEAVE;
  94     return ret;
  95 }
  96
  97 void perl_cleanup()
  98 {
  99     if (!my_perl)
 100         return;
 101
 102     perl_destruct(my_perl);
 103     perl_free(my_perl);
 104     PERL_SYS_TERM();
 105     my_perl = NULL;
 106     error_func = NULL;
 107 }