ekg2
 All Struktury Danych Pliki Funkcje Zmienne Definicje typów Wyliczenia Wartości wyliczeń Definicje Grupay Strony
perl_core.h
Idź do dokumentacji tego pliku.
1 #ifndef PERL_CORE_H
2 #define PERL_CORE_H
3 
4 #ifndef __FreeBSD__
5 #define __EXTENSIONS__
6 #endif
7 
8 #ifdef bool
9 #define HAS_BOOL
10 #endif
11 
12 #include <ekg/xmalloc.h>
13 #define fix(s) ((s) ? (s) : "") /* xmalloc.h */
14 
15 #include <EXTERN.h>
16 #include <perl.h>
17 #include <XSUB.h>
18 
19 /* syfffff irssi */
20 
21 #define new_pv(a) newSVpv(fix(a), xstrlen(a))
22 
23 #define is_hvref(o) \
24  ((o) && SvROK(o) && SvRV(o) && (SvTYPE(SvRV(o)) == SVt_PVHV))
25 
26 #define hvref(o) \
27  (is_hvref(o) ? (HV *)SvRV(o) : NULL)
28 
29 /* syfffff ekg2 */
30 
31 #define PERL_HANDLER_HEADER(x) \
32  char *fullproc, *error; \
33  int perl_retcount, ret = 0;\
34  SV *perl_ret;\
35  if (!x) return -1;\
36  fullproc = saprintf("Ekg2::Script::%s::%s", scr->name, x);\
37  { /* tag will be closed in PERL_HANDLER_FOOTER macro */ \
38  dSP;\
39  ENTER;\
40  SAVETMPS;\
41  PUSHMARK(sp);
42 
43 int perl_initialize();
44 int perl_finalize();
45 
46 SV *create_sv_ptr(void *object);
47 
48 #endif
49 /* zrobic to jakos ladniej... hack.*/
50 
51 #undef RESTORE_ARGS
52 #undef PERL_HANDLER_FOOTER
53 
54 #ifdef PERL_RESTORE_ARGS
55 #define RESTORE_ARGS(x)\
56  if (change) {\
57  for (i=0; i < scr_que->argc; i++) {\
58  switch ( scr_que->argv_type[i] ) {\
59  case (QUERY_ARG_INT):\
60  *( (int *) args[i]) = SvIV(SvRV(perlargs[i]));\
61  break;\
62 \
63  case (QUERY_ARG_CHARP):\
64  {\
65  char *retarg = xstrdup( SvPV_nolen(SvRV(perlargs[i])) ); \
66  if ( xstrcmp(retarg, *( (char **) args[i])) ) {\
67  xfree(*(char **) args[i]); \
68  *( (char **) args[i]) = retarg;\
69  } else\
70  xfree(retarg);\
71  break;\
72  }\
73  case (QUERY_ARG_CHARPP): /* wazne, zrobic. */\
74  break;\
75 \
76  }\
77  }\
78  }
79 
80 #else
81 #define RESTORE_ARGS(x) ;
82 #endif
83 
84 #define PERL_HANDLER_FOOTER()\
85  PUTBACK;\
86 /* perl_retcount = perl_call_sv(func, G_EVAL|G_DISCARD);*/\
87  perl_retcount = perl_call_pv(fullproc, G_EVAL);\
88  SPAGAIN;\
89  if (SvTRUE(ERRSV)) {\
90  error = SvPV(ERRSV, PL_na);\
91  print("script_error", error);\
92  ret = SCRIPT_HANDLE_UNBIND;\
93  }\
94  else if (perl_retcount > 0)\
95  {\
96  perl_ret = POPs;\
97  ret = SvIV(perl_ret);\
98  }\
99  RESTORE_ARGS(0);\
100 /* debug("%d %d\n", ret, perl_retcount); */\
101  \
102  PUTBACK;\
103  FREETMPS;\
104  LEAVE;\
105  \
106  if (ret < 0) return -1;\
107  else return ret; \
108  } /* closing tag defined in PERL_HANDLER_HEADER() macro */ \
109  xfree(fullproc);
110