Idź do dokumentacji tego pliku.00001 #ifndef PERL_CORE_H
00002 #define PERL_CORE_H
00003
00004 #ifndef __FreeBSD__
00005 #define __EXTENSIONS__
00006 #endif
00007
00008 #ifdef bool
00009 #define HAS_BOOL
00010 #endif
00011
00012 #include <ekg/xmalloc.h>
00013 #define fix(s) ((s) ? (s) : "")
00014
00015 #include <EXTERN.h>
00016 #include <perl.h>
00017 #include <XSUB.h>
00018
00019
00020
00021 #define new_pv(a) newSVpv(fix(a), xstrlen(a))
00022
00023 #define is_hvref(o) \
00024 ((o) && SvROK(o) && SvRV(o) && (SvTYPE(SvRV(o)) == SVt_PVHV))
00025
00026 #define hvref(o) \
00027 (is_hvref(o) ? (HV *)SvRV(o) : NULL)
00028
00029
00030
00031 #define PERL_HANDLER_HEADER(x) \
00032 char *fullproc, *error; \
00033 int perl_retcount, ret = 0;\
00034 SV *perl_ret;\
00035 if (!x) return -1;\
00036 fullproc = saprintf("Ekg2::Script::%s::%s", scr->name, x);\
00037 { \
00038 dSP;\
00039 ENTER;\
00040 SAVETMPS;\
00041 PUSHMARK(sp);
00042
00043 int perl_initialize();
00044 int perl_finalize();
00045
00046 SV *create_sv_ptr(void *object);
00047
00048 #endif
00049
00050
00051 #undef RESTORE_ARGS
00052 #undef PERL_HANDLER_FOOTER
00053
00054 #ifdef PERL_RESTORE_ARGS
00055 #define RESTORE_ARGS(x)\
00056 if (change) {\
00057 for (i=0; i < scr_que->argc; i++) {\
00058 switch ( scr_que->argv_type[i] ) {\
00059 case (QUERY_ARG_INT):\
00060 *( (int *) args[i]) = SvIV(SvRV(perlargs[i]));\
00061 break;\
00062 \
00063 case (QUERY_ARG_CHARP):\
00064 {\
00065 char *retarg = xstrdup( SvPV_nolen(SvRV(perlargs[i])) ); \
00066 if ( xstrcmp(retarg, *( (char **) args[i])) ) {\
00067 xfree(*(char **) args[i]); \
00068 *( (char **) args[i]) = retarg;\
00069 } else\
00070 xfree(retarg);\
00071 break;\
00072 }\
00073 case (QUERY_ARG_CHARPP): \
00074 break;\
00075 \
00076 }\
00077 }\
00078 }
00079
00080 #else
00081 #define RESTORE_ARGS(x) ;
00082 #endif
00083
00084 #define PERL_HANDLER_FOOTER()\
00085 PUTBACK;\
00086 \
00087 perl_retcount = perl_call_pv(fullproc, G_EVAL);\
00088 SPAGAIN;\
00089 if (SvTRUE(ERRSV)) {\
00090 error = SvPV(ERRSV, PL_na);\
00091 print("script_error", error);\
00092 ret = SCRIPT_HANDLE_UNBIND;\
00093 }\
00094 else if (perl_retcount > 0)\
00095 {\
00096 perl_ret = POPs;\
00097 ret = SvIV(perl_ret);\
00098 }\
00099 RESTORE_ARGS(0);\
00100 \
00101 \
00102 PUTBACK;\
00103 FREETMPS;\
00104 LEAVE;\
00105 \
00106 if (ret < 0) return -1;\
00107 else return ret; \
00108 } \
00109 xfree(fullproc);
00110