ekg2
|
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) : "") /* xmalloc.h */ 00014 00015 #include <EXTERN.h> 00016 #include <perl.h> 00017 #include <XSUB.h> 00018 00019 /* syfffff irssi */ 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 /* syfffff ekg2 */ 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 { /* tag will be closed in PERL_HANDLER_FOOTER macro */ \ 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 /* zrobic to jakos ladniej... hack.*/ 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): /* wazne, zrobic. */\ 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 /* perl_retcount = perl_call_sv(func, G_EVAL|G_DISCARD);*/\ 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 /* debug("%d %d\n", ret, perl_retcount); */\ 00101 \ 00102 PUTBACK;\ 00103 FREETMPS;\ 00104 LEAVE;\ 00105 \ 00106 if (ret < 0) return -1;\ 00107 else return ret; \ 00108 } /* closing tag defined in PERL_HANDLER_HEADER() macro */ \ 00109 xfree(fullproc); 00110