1/* -----------------------------------------------------------------------------
2 * perlrun.swg
3 *
4 * This file contains the runtime support for Perl modules
5 * and includes code for managing global variables and pointer
6 * type checking.
7 * ----------------------------------------------------------------------------- */
8
9#ifdef PERL_OBJECT
10#define SWIG_PERL_OBJECT_DECL CPerlObj *SWIGUNUSEDPARM(pPerl),
11#define SWIG_PERL_OBJECT_CALL pPerl,
12#else
13#define SWIG_PERL_OBJECT_DECL
14#define SWIG_PERL_OBJECT_CALL
15#endif
16
17/* Common SWIG API */
18
19/* for raw pointers */
20#define SWIG_ConvertPtr(obj, pp, type, flags)           SWIG_Perl_ConvertPtr(SWIG_PERL_OBJECT_CALL obj, pp, type, flags)
21#define SWIG_ConvertPtrAndOwn(obj, pp, type, flags,own) SWIG_Perl_ConvertPtrAndOwn(SWIG_PERL_OBJECT_CALL obj, pp, type, flags, own)
22#define SWIG_NewPointerObj(p, type, flags)              SWIG_Perl_NewPointerObj(SWIG_PERL_OBJECT_CALL p, type, flags)
23#define swig_owntype                                    int
24
25/* for raw packed data */
26#define SWIG_ConvertPacked(obj, p, s, type)             SWIG_Perl_ConvertPacked(SWIG_PERL_OBJECT_CALL obj, p, s, type)
27#define SWIG_NewPackedObj(p, s, type)	                SWIG_Perl_NewPackedObj(SWIG_PERL_OBJECT_CALL p, s, type)
28
29/* for class or struct pointers */
30#define SWIG_ConvertInstance(obj, pptr, type, flags)    SWIG_ConvertPtr(obj, pptr, type, flags)
31#define SWIG_NewInstanceObj(ptr, type, flags)           SWIG_NewPointerObj(ptr, type, flags)
32
33/* for C or C++ function pointers */
34#define SWIG_ConvertFunctionPtr(obj, pptr, type)        SWIG_ConvertPtr(obj, pptr, type, 0)
35#define SWIG_NewFunctionPtrObj(ptr, type)               SWIG_NewPointerObj(ptr, type, 0)
36
37/* for C++ member pointers, ie, member methods */
38#define SWIG_ConvertMember(obj, ptr, sz, ty)            SWIG_ConvertPacked(obj, ptr, sz, ty)
39#define SWIG_NewMemberObj(ptr, sz, type)                SWIG_NewPackedObj(ptr, sz, type)
40
41
42/* Runtime API */
43
44#define SWIG_GetModule(clientdata)                      SWIG_Perl_GetModule(clientdata)
45#define SWIG_SetModule(clientdata, pointer)             SWIG_Perl_SetModule(pointer)
46
47
48/* Error manipulation */
49
50#define SWIG_ErrorType(code)                            SWIG_Perl_ErrorType(code)
51#define SWIG_Error(code, msg)            		sv_setpvf(get_sv("@", GV_ADD), "%s %s", SWIG_ErrorType(code), msg)
52#define SWIG_fail                        		goto fail
53
54/* Perl-specific SWIG API */
55
56#define SWIG_MakePtr(sv, ptr, type, flags)              SWIG_Perl_MakePtr(SWIG_PERL_OBJECT_CALL sv, ptr, type, flags)
57#define SWIG_MakePackedObj(sv, p, s, type)	        SWIG_Perl_MakePackedObj(SWIG_PERL_OBJECT_CALL sv, p, s, type)
58#define SWIG_SetError(str)                              SWIG_Error(SWIG_RuntimeError, str)
59
60
61#define SWIG_PERL_DECL_ARGS_1(arg1)                     (SWIG_PERL_OBJECT_DECL arg1)
62#define SWIG_PERL_CALL_ARGS_1(arg1)                     (SWIG_PERL_OBJECT_CALL arg1)
63#define SWIG_PERL_DECL_ARGS_2(arg1, arg2)               (SWIG_PERL_OBJECT_DECL arg1, arg2)
64#define SWIG_PERL_CALL_ARGS_2(arg1, arg2)               (SWIG_PERL_OBJECT_CALL arg1, arg2)
65
66/* -----------------------------------------------------------------------------
67 * pointers/data manipulation
68 * ----------------------------------------------------------------------------- */
69
70/* For backward compatibility only */
71#define SWIG_POINTER_EXCEPTION  0
72
73#ifdef __cplusplus
74extern "C" {
75#endif
76
77#define SWIG_OWNER   SWIG_POINTER_OWN
78#define SWIG_SHADOW  SWIG_OWNER << 1
79
80#define SWIG_MAYBE_PERL_OBJECT SWIG_PERL_OBJECT_DECL
81
82/* SWIG Perl macros */
83
84/* Macro to declare an XS function */
85#ifndef XSPROTO
86#   define XSPROTO(name) void name(pTHX_ CV* cv)
87#endif
88
89/* Macro to call an XS function */
90#ifdef PERL_OBJECT
91#  define SWIG_CALLXS(_name) _name(cv,pPerl)
92#else
93#  ifndef MULTIPLICITY
94#    define SWIG_CALLXS(_name) _name(cv)
95#  else
96#    define SWIG_CALLXS(_name) _name(PERL_GET_THX, cv)
97#  endif
98#endif
99
100#ifdef PERL_OBJECT
101#define MAGIC_PPERL  CPerlObj *pPerl = (CPerlObj *) this;
102
103#ifdef __cplusplus
104extern "C" {
105#endif
106typedef int (CPerlObj::*SwigMagicFunc)(SV *, MAGIC *);
107#ifdef __cplusplus
108}
109#endif
110
111#define SWIG_MAGIC(a,b) (SV *a, MAGIC *b)
112#define SWIGCLASS_STATIC
113
114#else /* PERL_OBJECT */
115
116#define MAGIC_PPERL
117#define SWIGCLASS_STATIC static SWIGUNUSED
118
119#ifndef MULTIPLICITY
120#define SWIG_MAGIC(a,b) (SV *a, MAGIC *b)
121
122#ifdef __cplusplus
123extern "C" {
124#endif
125typedef int (*SwigMagicFunc)(SV *, MAGIC *);
126#ifdef __cplusplus
127}
128#endif
129
130#else /* MULTIPLICITY */
131
132#define SWIG_MAGIC(a,b) (struct interpreter *interp, SV *a, MAGIC *b)
133
134#ifdef __cplusplus
135extern "C" {
136#endif
137typedef int (*SwigMagicFunc)(struct interpreter *, SV *, MAGIC *);
138#ifdef __cplusplus
139}
140#endif
141
142#endif /* MULTIPLICITY */
143#endif /* PERL_OBJECT */
144
145#  ifdef PERL_OBJECT
146#    define SWIG_croak_null() SWIG_Perl_croak_null(pPerl)
147static void SWIGUNUSED SWIG_Perl_croak_null(CPerlObj *pPerl)
148#  else
149static void SWIGUNUSED SWIG_croak_null()
150#  endif
151{
152  SV *err = get_sv("@", GV_ADD);
153#  if (PERL_VERSION < 6)
154  croak("%_", err);
155#  else
156  if (sv_isobject(err))
157    croak(0);
158  else
159    croak("%s", SvPV_nolen(err));
160#  endif
161}
162
163
164/*
165   Define how strict is the cast between strings and integers/doubles
166   when overloading between these types occurs.
167
168   The default is making it as strict as possible by using SWIG_AddCast
169   when needed.
170
171   You can use -DSWIG_PERL_NO_STRICT_STR2NUM at compilation time to
172   disable the SWIG_AddCast, making the casting between string and
173   numbers less strict.
174
175   In the end, we try to solve the overloading between strings and
176   numerical types in the more natural way, but if you can avoid it,
177   well, avoid it using %rename, for example.
178*/
179#ifndef SWIG_PERL_NO_STRICT_STR2NUM
180# ifndef SWIG_PERL_STRICT_STR2NUM
181#  define SWIG_PERL_STRICT_STR2NUM
182# endif
183#endif
184#ifdef SWIG_PERL_STRICT_STR2NUM
185/* string takes precedence */
186#define SWIG_Str2NumCast(x) SWIG_AddCast(x)
187#else
188/* number takes precedence */
189#define SWIG_Str2NumCast(x) x
190#endif
191
192
193
194#include <stdlib.h>
195
196SWIGRUNTIME const char *
197SWIG_Perl_TypeProxyName(const swig_type_info *type) {
198  if (!type) return NULL;
199  if (type->clientdata != NULL) {
200    return (const char*) type->clientdata;
201  }
202  else {
203    return type->name;
204  }
205}
206
207/* Identical to SWIG_TypeCheck, except for strcmp comparison */
208SWIGRUNTIME swig_cast_info *
209SWIG_TypeProxyCheck(const char *c, swig_type_info *ty) {
210  if (ty) {
211    swig_cast_info *iter = ty->cast;
212    while (iter) {
213      if (strcmp(SWIG_Perl_TypeProxyName(iter->type), c) == 0) {
214        if (iter == ty->cast)
215          return iter;
216        /* Move iter to the top of the linked list */
217        iter->prev->next = iter->next;
218        if (iter->next)
219          iter->next->prev = iter->prev;
220        iter->next = ty->cast;
221        iter->prev = 0;
222        if (ty->cast) ty->cast->prev = iter;
223        ty->cast = iter;
224        return iter;
225      }
226      iter = iter->next;
227    }
228  }
229  return 0;
230}
231
232/* Function for getting a pointer value */
233
234SWIGRUNTIME int
235SWIG_Perl_ConvertPtrAndOwn(SWIG_MAYBE_PERL_OBJECT SV *sv, void **ptr, swig_type_info *_t, int flags, int *own) {
236  swig_cast_info *tc;
237  void *voidptr = (void *)0;
238  SV *tsv = 0;
239
240  if (own)
241    *own = 0;
242
243  /* If magical, apply more magic */
244  if (SvGMAGICAL(sv))
245    mg_get(sv);
246
247  /* Check to see if this is an object */
248  if (sv_isobject(sv)) {
249    IV tmp = 0;
250    tsv = (SV*) SvRV(sv);
251    if ((SvTYPE(tsv) == SVt_PVHV)) {
252      MAGIC *mg;
253      if (SvMAGICAL(tsv)) {
254        mg = mg_find(tsv,'P');
255        if (mg) {
256          sv = mg->mg_obj;
257          if (sv_isobject(sv)) {
258	    tsv = (SV*)SvRV(sv);
259            tmp = SvIV(tsv);
260          }
261        }
262      } else {
263        return SWIG_ERROR;
264      }
265    } else {
266      tmp = SvIV(tsv);
267    }
268    voidptr = INT2PTR(void *,tmp);
269  } else if (! SvOK(sv)) {            /* Check for undef */
270    *(ptr) = (void *) 0;
271    return SWIG_OK;
272  } else if (SvTYPE(sv) == SVt_RV) {  /* Check for NULL pointer */
273    if (!SvROK(sv)) {
274      /* In Perl 5.12 and later, SVt_RV == SVt_IV, so sv could be a valid integer value.  */
275      if (SvIOK(sv)) {
276        return SWIG_ERROR;
277      } else {
278        /* NULL pointer (reference to undef). */
279        *(ptr) = (void *) 0;
280        return SWIG_OK;
281      }
282    } else {
283      return SWIG_ERROR;
284    }
285  } else {                            /* Don't know what it is */
286    return SWIG_ERROR;
287  }
288  if (_t) {
289    /* Now see if the types match */
290    char *_c = HvNAME(SvSTASH(SvRV(sv)));
291    tc = SWIG_TypeProxyCheck(_c,_t);
292#ifdef SWIG_DIRECTORS
293    if (!tc && !sv_derived_from(sv,SWIG_Perl_TypeProxyName(_t))) {
294#else
295    if (!tc) {
296#endif
297      return SWIG_ERROR;
298    }
299    {
300      int newmemory = 0;
301      *ptr = SWIG_TypeCast(tc,voidptr,&newmemory);
302      if (newmemory == SWIG_CAST_NEW_MEMORY) {
303        assert(own); /* badly formed typemap which will lead to a memory leak - it must set and use own to delete *ptr */
304        if (own)
305          *own = *own | SWIG_CAST_NEW_MEMORY;
306      }
307    }
308  } else {
309    *ptr = voidptr;
310  }
311
312  /*
313   *  DISOWN implementation: we need a perl guru to check this one.
314   */
315  if (tsv && (flags & SWIG_POINTER_DISOWN)) {
316    /*
317     *  almost copy paste code from below SWIG_POINTER_OWN setting
318     */
319    SV *obj = sv;
320    HV *stash = SvSTASH(SvRV(obj));
321    GV *gv = *(GV**)hv_fetch(stash, "OWNER", 5, TRUE);
322    if (isGV(gv)) {
323      HV *hv = GvHVn(gv);
324      /*
325       * To set ownership (see below), a newSViv(1) entry is added.
326       * Hence, to remove ownership, we delete the entry.
327       */
328      if (hv_exists_ent(hv, obj, 0)) {
329	hv_delete_ent(hv, obj, 0, 0);
330      }
331    }
332  }
333  return SWIG_OK;
334}
335
336SWIGRUNTIME int
337SWIG_Perl_ConvertPtr(SWIG_MAYBE_PERL_OBJECT SV *sv, void **ptr, swig_type_info *_t, int flags) {
338  return SWIG_Perl_ConvertPtrAndOwn(sv, ptr, _t, flags, 0);
339}
340
341SWIGRUNTIME void
342SWIG_Perl_MakePtr(SWIG_MAYBE_PERL_OBJECT SV *sv, void *ptr, swig_type_info *t, int flags) {
343  if (ptr && (flags & (SWIG_SHADOW | SWIG_POINTER_OWN))) {
344    SV *self;
345    SV *obj=newSV(0);
346    HV *hash=newHV();
347    HV *stash;
348    sv_setref_pv(obj, SWIG_Perl_TypeProxyName(t), ptr);
349    stash=SvSTASH(SvRV(obj));
350    if (flags & SWIG_POINTER_OWN) {
351      HV *hv;
352      GV *gv = *(GV**)hv_fetch(stash, "OWNER", 5, TRUE);
353      if (!isGV(gv))
354        gv_init(gv, stash, "OWNER", 5, FALSE);
355      hv=GvHVn(gv);
356      hv_store_ent(hv, obj, newSViv(1), 0);
357    }
358    sv_magic((SV *)hash, (SV *)obj, 'P', Nullch, 0);
359    SvREFCNT_dec(obj);
360    self=newRV_noinc((SV *)hash);
361    sv_setsv(sv, self);
362    SvREFCNT_dec((SV *)self);
363    sv_bless(sv, stash);
364  }
365  else {
366    sv_setref_pv(sv, SWIG_Perl_TypeProxyName(t), ptr);
367  }
368}
369
370SWIGRUNTIMEINLINE SV *
371SWIG_Perl_NewPointerObj(SWIG_MAYBE_PERL_OBJECT void *ptr, swig_type_info *t, int flags) {
372  SV *result = sv_newmortal();
373  SWIG_MakePtr(result, ptr, t, flags);
374  return result;
375}
376
377SWIGRUNTIME void
378SWIG_Perl_MakePackedObj(SWIG_MAYBE_PERL_OBJECT SV *sv, void *ptr, int sz, swig_type_info *type) {
379  char result[1024];
380  char *r = result;
381  if ((2*sz + 1 + strlen(SWIG_Perl_TypeProxyName(type))) > 1000) return;
382  *(r++) = '_';
383  r = SWIG_PackData(r,ptr,sz);
384  strcpy(r,SWIG_Perl_TypeProxyName(type));
385  sv_setpv(sv, result);
386}
387
388SWIGRUNTIME SV *
389SWIG_Perl_NewPackedObj(SWIG_MAYBE_PERL_OBJECT void *ptr, int sz, swig_type_info *type) {
390  SV *result = sv_newmortal();
391  SWIG_Perl_MakePackedObj(result, ptr, sz, type);
392  return result;
393}
394
395/* Convert a packed value value */
396SWIGRUNTIME int
397SWIG_Perl_ConvertPacked(SWIG_MAYBE_PERL_OBJECT SV *obj, void *ptr, int sz, swig_type_info *ty) {
398  swig_cast_info *tc;
399  const char  *c = 0;
400
401  if ((!obj) || (!SvOK(obj))) return SWIG_ERROR;
402  c = SvPV_nolen(obj);
403  /* Pointer values must start with leading underscore */
404  if (*c != '_') return SWIG_ERROR;
405  c++;
406  c = SWIG_UnpackData(c,ptr,sz);
407  if (ty) {
408    tc = SWIG_TypeCheck(c,ty);
409    if (!tc) return SWIG_ERROR;
410  }
411  return SWIG_OK;
412}
413
414
415/* Macros for low-level exception handling */
416#define SWIG_croak(x)    { SWIG_Error(SWIG_RuntimeError, x); SWIG_fail; }
417
418
419typedef XSPROTO(SwigPerlWrapper);
420typedef SwigPerlWrapper *SwigPerlWrapperPtr;
421
422/* Structure for command table */
423typedef struct {
424  const char         *name;
425  SwigPerlWrapperPtr  wrapper;
426} swig_command_info;
427
428/* Information for constant table */
429
430#define SWIG_INT     1
431#define SWIG_FLOAT   2
432#define SWIG_STRING  3
433#define SWIG_POINTER 4
434#define SWIG_BINARY  5
435
436/* Constant information structure */
437typedef struct swig_constant_info {
438    int              type;
439    const char      *name;
440    long             lvalue;
441    double           dvalue;
442    void            *pvalue;
443    swig_type_info **ptype;
444} swig_constant_info;
445
446
447/* Structure for variable table */
448typedef struct {
449  const char   *name;
450  SwigMagicFunc   set;
451  SwigMagicFunc   get;
452  swig_type_info  **type;
453} swig_variable_info;
454
455/* Magic variable code */
456#ifndef PERL_OBJECT
457# ifdef __cplusplus
458#  define swig_create_magic(s,a,b,c) _swig_create_magic(s,const_cast<char*>(a),b,c)
459# else
460#  define swig_create_magic(s,a,b,c) _swig_create_magic(s,(char*)(a),b,c)
461# endif
462# ifndef MULTIPLICITY
463SWIGRUNTIME void _swig_create_magic(SV *sv, char *name, int (*set)(SV *, MAGIC *), int (*get)(SV *,MAGIC *))
464# else
465SWIGRUNTIME void _swig_create_magic(SV *sv, char *name, int (*set)(struct interpreter*, SV *, MAGIC *), int (*get)(struct interpreter*, SV *,MAGIC *))
466# endif
467#else
468#  define swig_create_magic(s,a,b,c) _swig_create_magic(pPerl,s,a,b,c)
469SWIGRUNTIME void _swig_create_magic(CPerlObj *pPerl, SV *sv, const char *name, int (CPerlObj::*set)(SV *, MAGIC *), int (CPerlObj::*get)(SV *, MAGIC *))
470#endif
471{
472  MAGIC *mg;
473  sv_magic(sv,sv,'U',name,strlen(name));
474  mg = mg_find(sv,'U');
475  mg->mg_virtual = (MGVTBL *) malloc(sizeof(MGVTBL));
476  mg->mg_virtual->svt_get = (SwigMagicFunc) get;
477  mg->mg_virtual->svt_set = (SwigMagicFunc) set;
478  mg->mg_virtual->svt_len = 0;
479  mg->mg_virtual->svt_clear = 0;
480  mg->mg_virtual->svt_free = 0;
481}
482
483
484SWIGRUNTIME swig_module_info *
485SWIG_Perl_GetModule(void *SWIGUNUSEDPARM(clientdata)) {
486  static void *type_pointer = (void *)0;
487  SV *pointer;
488
489  /* first check if pointer already created */
490  if (!type_pointer) {
491    pointer = get_sv("swig_runtime_data::type_pointer" SWIG_RUNTIME_VERSION SWIG_TYPE_TABLE_NAME, FALSE | GV_ADDMULTI);
492    if (pointer && SvOK(pointer)) {
493      type_pointer = INT2PTR(swig_type_info **, SvIV(pointer));
494    }
495  }
496
497  return (swig_module_info *) type_pointer;
498}
499
500SWIGRUNTIME void
501SWIG_Perl_SetModule(swig_module_info *module) {
502  SV *pointer;
503
504  /* create a new pointer */
505  pointer = get_sv("swig_runtime_data::type_pointer" SWIG_RUNTIME_VERSION SWIG_TYPE_TABLE_NAME, TRUE | GV_ADDMULTI);
506  sv_setiv(pointer, PTR2IV(module));
507}
508
509#ifdef __cplusplus
510}
511#endif
512