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