rpm  5.4.14
rpmperl.c
Go to the documentation of this file.
1 #include "system.h"
2 
3 #include <argv.h>
4 
5 #undef _ /* XXX everyone gotta be different */
6 #define _RPMPERL_INTERNAL
7 #include "rpmperl.h"
8 #include <rpmmacro.h>
9 
10 #if defined(WITH_PERLEMBED)
11 #include <EXTERN.h>
12 #include <perl.h>
13 #endif
14 
15 #undef UNLIKELY /* XXX everyone gotta be different */
16 #include "debug.h"
17 
18 /*@unchecked@*/
20 
21 /*@unchecked@*/ /*@relnull@*/
23 
24 #define my_perl ((PerlInterpreter *)perl->I)
25 
26 static void rpmperlFini(void * _perl)
27  /*@globals fileSystem @*/
28  /*@modifies *_perl, fileSystem @*/
29 {
30  rpmperl perl = (rpmperl) _perl;
31 
32 #if defined(WITH_PERLEMBED)
33  PERL_SET_CONTEXT(my_perl);
34  PL_perl_destruct_level = 1;
35  perl_destruct(my_perl);
36  perl_free(my_perl);
37  if (perl == _rpmperlI) /* XXX necessary on HP-UX? */
38  PERL_SYS_TERM();
39 #endif
40  perl->I = NULL;
41 }
42 
43 /*@unchecked@*/ /*@only@*/ /*@null@*/
45 
46 static rpmperl rpmperlGetPool(/*@null@*/ rpmioPool pool)
47  /*@globals _rpmperlPool, fileSystem @*/
48  /*@modifies pool, _rpmperlPool, fileSystem @*/
49 {
50  rpmperl perl;
51 
52  if (_rpmperlPool == NULL) {
53  _rpmperlPool = rpmioNewPool("perl", sizeof(*perl), -1, _rpmperl_debug,
55  pool = _rpmperlPool;
56  }
57  return (rpmperl) rpmioGetPool(pool, sizeof(*perl));
58 }
59 
60 #if defined(WITH_PERLEMBED)
61 EXTERN_C void xs_init (PerlInterpreter * _my_perl PERL_UNUSED_DECL);
62 
63 EXTERN_C void boot_DynaLoader (PerlInterpreter* _my_perl, CV* cv);
64 
65 EXTERN_C void
66 xs_init(PerlInterpreter* _my_perl PERL_UNUSED_DECL)
67 {
68  char * file = (char *) __FILE__;
69  dXSUB_SYS;
70 
71  /* DynaLoader is a special case */
72  Perl_newXS(_my_perl, "DynaLoader::boot_DynaLoader", boot_DynaLoader, file);
73 }
74 
75 /*@unchecked@*/
76 static const char * _rpmperlI_init = "\
77 use strict;\n\
78 use IO::String;\n\
79 our $io = IO::String->new;\n\
80 select $io;\n\
81 ";
82 #endif
83 
84 static rpmperl rpmperlI(void)
85  /*@globals _rpmperlI @*/
86  /*@modifies _rpmperlI @*/
87 {
88  if (_rpmperlI == NULL)
90  return _rpmperlI;
91 }
92 
93 rpmperl rpmperlNew(char ** av, uint32_t flags)
94 {
95  rpmperl perl =
96 #ifdef NOTYET
97  (flags & 0x80000000) ? rpmperlI() :
98 #endif
99  rpmperlGetPool(_rpmperlPool);
100 #if defined(WITH_PERLEMBED)
101  static const char * _av[] = { "rpmperl", NULL };
102  static int initialized = 0;
103  ARGV_t argv = NULL;
104  int argc = 0;
105  int xx;
106 
107  if (av == NULL) av = (char **) _av;
108 
109  /* Build argv(argc) for the interpreter. */
110  xx = argvAdd(&argv, av[0]);
111  { static const char _perlI_init[] = "%{?_perlI_init}";
112  const char * s = rpmExpand(_rpmperlI_init, _perlI_init, NULL);
113  if (s && *s) {
114  xx = argvAdd(&argv, "-e");
115  xx = argvAdd(&argv, s);
116  }
117  s = _free(s);
118  }
119  if (av[1])
120  xx = argvAppend(&argv, (ARGV_t)av+1);
121  argc = argvCount(argv);
122 
123  if (!initialized) {
124  /* XXX claimed necessary on HP-UX */
125  PERL_SYS_INIT3(&argc, (char ***)&argv, &environ);
126  initialized++;
127  }
128  perl->I = perl_alloc();
129  PERL_SET_CONTEXT(my_perl);
130  PL_perl_destruct_level = 1;
131  perl_construct(my_perl);
132 
133  PL_origalen = 1; /* don't let $0 assignment update proctitle/embedding[0] */
134  xx = perl_parse(my_perl, xs_init, argc, (char **)argv, NULL);
135  PL_exit_flags |= PERL_EXIT_DESTRUCT_END;
136  perl_run(my_perl);
137 
138  argv = argvFree(argv);
139 #endif
140 
141  return rpmperlLink(perl);
142 }
143 
144 rpmRC rpmperlRun(rpmperl perl, const char * str, const char ** resultp)
145 {
146  rpmRC rc = RPMRC_FAIL;
147 
148 if (_rpmperl_debug)
149 fprintf(stderr, "==> %s(%p,%s)\n", __FUNCTION__, perl, str);
150 
151  if (perl == NULL) perl = rpmperlI();
152 
153  if (str != NULL) {
154 #if defined(WITH_PERLEMBED)
155  STRLEN n_a;
156  SV * retSV;
157 
158  retSV = Perl_eval_pv(my_perl, str, TRUE);
159  if (SvTRUE(ERRSV)) {
160  fprintf(stderr, "==> FIXME #1: %d %s\n",
161  (int)SvTRUE(ERRSV), SvPV(ERRSV, n_a));
162  } else {
163  if (resultp) {
164  retSV = Perl_eval_pv(my_perl, "${$io->string_ref}", TRUE);
165  if (SvTRUE(ERRSV)) {
166  fprintf(stderr, "==> FIXME #2: %d %s\n",
167  (int)SvTRUE(ERRSV), SvPV(ERRSV, n_a));
168  } else {
169  *resultp = SvPV(retSV, n_a);
170  rc = RPMRC_OK;
171  }
172  } else
173  rc = RPMRC_OK;
174  }
175 #endif
176  }
177  return rc;
178 }
int xx
Definition: spec.c:744
rpmperl rpmperlLink(rpmperl perl)
Reference a perl interpreter instance.
int rc
Definition: poptALL.c:670
int argvAppend(ARGV_t *argvp, ARGV_t av)
Append one argv array to another.
Definition: argv.c:216
static rpmperl rpmperlI(void)
Definition: rpmperl.c:84
char ** environ
argv
Definition: rpmmtree.c:3679
enum rpmRC_e rpmRC
RPM return codes.
Definition: signature.c:616
#define STRLEN(S)
Definition: fnmatch.c:167
#define TRUE
Definition: rpmgrep.c:53
int _rpmperl_debug
Definition: rpmperl.c:19
rpmioItem rpmioGetPool(rpmioPool pool, size_t size)
Get unused item from pool, or alloc a new item.
Definition: rpmmalloc.c:220
fprintf(stderr,"--> %s(%p,%p,%p) sig %p sigp %p\n", __FUNCTION__, dig, t, rsactx, sig, sigp)
rpmioPool _rpmperlPool
Definition: rpmperl.c:44
int argvCount(const ARGV_t argv)
Return no.
Definition: argv.c:71
struct rpmperl_s * rpmperl
Definition: rpmperl.h:11
ARGV_t argvFree(ARGV_t argv)
Destroy an argv array.
Definition: argv.c:44
rpmperl rpmperlNew(char **av, uint32_t flags)
Create and load a perl interpreter.
Definition: rpmperl.c:93
static const char * file
Definition: parseFiles.c:20
int argvAdd(ARGV_t *argvp, ARGstr_t val)
Add a string to an argv array.
Definition: argv.c:199
char * rpmExpand(const char *arg,...)
Return (malloc&#39;ed) concatenated macro expansion(s).
Definition: macro.c:3178
rpmperl _rpmperlI
Definition: rpmperl.c:22
#define my_perl
Definition: rpmperl.c:24
const char * s
Definition: poptALL.c:734
rpmioPool rpmioNewPool(const char *name, size_t size, int limit, int flags, char *(*dbg)(void *item), void(*init)(void *item), void(*fini)(void *item))
Create a memory pool.
Definition: rpmmalloc.c:109
int flags
Definition: fnmatch.c:282
return NULL
Definition: poptALL.c:613
static rpmperl rpmperlGetPool(rpmioPool pool)
Definition: rpmperl.c:46
static void rpmperlFini(void *_perl)
Definition: rpmperl.c:26
ARGstr_t * ARGV_t
Definition: argv.h:12
static void * _free(const void *p)
Wrapper to free(3), hides const compilation noise, permit NULL, return NULL.
Definition: rpmiotypes.h:647
rpmRC rpmperlRun(rpmperl perl, const char *str, const char **resultp)
Execute perl string.
Definition: rpmperl.c:144
const char ** av
Definition: rpmts-py.c:788