modules/perl.c

   1 /* GNU m4 -- A simple macro processor
   2    Copyright (C) 1999, 2000, 2006, 2007, 2008 Free Software
   3    Foundation, Inc.
   4
   5    This file is part of GNU M4.
   6
   7    GNU M4 is free software: you can redistribute it and/or modify
   8    it under the terms of the GNU General Public License as published by
   9    the Free Software Foundation, either version 3 of the License, or
  10    (at your option) any later version.
  11
  12    GNU M4 is distributed in the hope that it will be useful,
  13    but WITHOUT ANY WARRANTY; without even the implied warranty of
  14    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15    GNU General Public License for more details.
  16
  17    You should have received a copy of the GNU General Public License
  18    along with this program.  If not, see <http://www.gnu.org/licenses/>.
  19 */
  20
  21 #include <config.h>
  22
  23 /* Build using only the exported interfaces, unless NDEBUG is set, in
  24    which case use private symbols to speed things up as much as possible.  */
  25 #ifndef NDEBUG
  26 #  include <m4/m4module.h>
  27 #else
  28 #  include "m4private.h"
  29 #endif
  30
  31 #undef PACKAGE
  32 #include "perlxsi.c"                    /* Perl stuff */
  33 #undef try
  34 #undef _
  35
  36 /* Rename exported symbols for dlpreload()ing.  */
  37 #define m4_builtin_table        perl_LTX_m4_builtin_table
  38 #define m4_macro_table          perl_LTX_m4_macro_table
  39
  40 /*         function     macros  blind   side    minargs maxargs */
  41 #define builtin_functions                                       \
  42   BUILTIN (perleval,    false,  false,  false,  0,      -1  )   \
  43
  44
  45 #define BUILTIN(handler, macros, blind, side, min, max)  M4BUILTIN (handler)
  46   builtin_functions
  47 #undef BUILTIN
  48
  49 const m4_builtin m4_builtin_table[] =
  50 {
  51 #define BUILTIN(handler, macros, blind, side, min, max)                 \
  52   M4BUILTIN_ENTRY (handler, #handler, macros, blind, side, min, max)
  53
  54   builtin_functions
  55 #undef BUILTIN
  56
  57   { NULL, NULL, 0, 0, 0 },
  58 };
  59
  60 /* A table for mapping m4 symbol names to simple expansion text. */
  61 const m4_macro m4_macro_table[] =
  62 {
  63   /* name               text    min     max */
  64   { "__perleval__",     "",     0,      0 },
  65   { NULL,               NULL,   0,      0 },
  66 };
  67
  68
  69 \f
  70 static PerlInterpreter *my_perl;
  71
  72 M4INIT_HANDLER (perl)
  73 {
  74   const lt_dlinfo *info = 0;
  75   char *embedding[] = { "", "-e", "0" };
  76
  77   if (module)
  78     info = lt_dlgetinfo (module);
  79
  80   /* Start up a perl parser, when loaded for the first time.  */
  81   if (info && (info->ref_count == 1))
  82     {
  83       my_perl = perl_alloc ();
  84       perl_construct (my_perl);
  85
  86       perl_parse (my_perl, xs_init, 3, embedding, NULL);
  87       perl_run (my_perl);
  88     }
  89 }
  90
  91 M4FINISH_HANDLER (perl)
  92 {
  93   const lt_dlinfo *info = 0;
  94
  95   if (module)
  96     info = lt_dlgetinfo (module);
  97
  98   /* Recycle the perl parser, when unloaded for the last time.  */
  99   if (info && (info->ref_count == 1))
 100     {
 101       perl_destruct (my_perl);
 102       perl_free (my_perl);
 103     }
 104 }
 105
 106
 107 \f
 108 /**
 109  * perleval([PERLCODE], [...])
 110  **/
 111 M4BUILTIN_HANDLER (perleval)
 112 {
 113   SV *val;
 114   size_t i;
 115
 116   for (i = 1; i < argc; i++)
 117     {
 118       if (i > 1)
 119         obstack_1grow (obs, ',');
 120
 121       val = perl_eval_pv (M4ARG (i), true);
 122
 123       m4_shipout_string (context, obs, SvPV (val, PL_na), SIZE_MAX, false);
 124     }
 125 }