# HG changeset patch # User Christian Hammond # Date 1061509312 0 # Node ID f6c2a7b5afa79d48d1cde1228545124b3debda21 # Parent cb00e9647033539b98a30a2b17d078da1a59cfc0 [gaim-migrate @ 7088] PERL SIGNAL HANDLING WORKS!!!! Ahem. I shall now continue professionally developing other aspects of this instant messenger application. WOOHOO committer: Tailor Script diff -r cb00e9647033 -r f6c2a7b5afa7 plugins/perl/perl-common.c --- a/plugins/perl/perl-common.c Thu Aug 21 23:26:13 2003 +0000 +++ b/plugins/perl/perl-common.c Thu Aug 21 23:41:52 2003 +0000 @@ -1,4 +1,5 @@ #include "debug.h" +#include "value.h" #include "perl-common.h" @@ -35,6 +36,20 @@ } SV * +newSVGChar(const char *str) +{ + SV *sv; + + if (str == NULL) + return &PL_sv_undef; + + sv = newSVpv(str, 0); + SvUTF8_on(sv); + + return sv; +} + +SV * gaim_perl_bless_object(void *object, const char *stash_name) { HV *stash; @@ -51,13 +66,6 @@ hv_store(hv, "_gaim", 5, create_sv_ptr(object), 0); return sv_bless(newRV_noinc((SV *)hv), stash); - -// return sv_bless(create_sv_ptr(object), gv_stashpv(stash, 1)); -// return create_sv_ptr(object); - -// dXSARGS; - -// return sv_setref_pv(ST(0), "Gaim::Account", create_sv_ptr(object)); } gboolean @@ -216,4 +224,199 @@ return ret_value; } +#if 0 +gboolean +gaim_perl_value_from_sv(GaimValue *value, SV *sv) +{ + switch (gaim_value_get_type(value)) + { + case GAIM_TYPE_CHAR: + if ((tmp = SvGChar(sv)) != NULL) + gaim_value_set_char(value, tmp[0]); + else + return FALSE; + break; + case GAIM_TYPE_UCHAR: + if ((tmp = SvPV_nolen(sv)) != NULL) + gaim_value_set_uchar(value, tmp[0]); + else + return FALSE; + break; + + case GAIM_TYPE_BOOLEAN: + gaim_value_set_boolean(value, SvTRUE(sv)); + break; + + case GAIM_TYPE_INT: + gaim_value_set_int(value, SvIV(sv)); + break; + + case GAIM_TYPE_UINT: + gaim_value_set_uint(value, SvIV(sv)); + break; + + case GAIM_TYPE_LONG: + gaim_value_set_long(value, SvIV(sv)); + break; + + case GAIM_TYPE_ULONG: + gaim_value_set_ulong(value, SvIV(sv)); + break; + + case GAIM_TYPE_INT64: + gaim_value_set_int64(value, SvIV(sv)); + break; + + case GAIM_TYPE_UINT64: + gaim_value_set_uint64(value, SvIV(sv)); + break; + + case GAIM_TYPE_STRING: + gaim_value_set_string(value, SvGChar(sv)); + break; + + case GAIM_TYPE_POINTER: + gaim_value_set_pointer(value, (void *)SvIV(sv)); + break; + + case GAIM_TYPE_BOXED: + if (!strcmp(gaim_value_get_specific_type(value), "SV")) + gaim_value_set_boxed(value, (sv == &PL_sv_undef ? NULL : sv)); + else + gaim_value_set_boxed(value, sv); + break; + + default: + return FALSE; + } + + return TRUE; +} + +SV * +gaim_perl_sv_from_value(const GaimValue *value, va_list list) +{ + switch (gaim_value_get_type(value)) + { + case GAIM_TYPE_BOOLEAN: + return newSViv(gaim_value_get_boolean(value)); + break; + + case GAIM_TYPE_INT: + return newSViv(gaim_value_get_int(value)); + break; + + case GAIM_TYPE_UINT: + return newSVuv(gaim_value_get_uint(value)); + break; + + case GAIM_TYPE_LONG: + return newSViv(gaim_value_get_long(value)); + break; + + case GAIM_TYPE_ULONG: + return newSVuv(gaim_value_get_ulong(value)); + break; + + case GAIM_TYPE_INT64: + return newSViv(gaim_value_get_int64(value)); + break; + + case GAIM_TYPE_UINT64: + return newSVuv(gaim_value_get_int64(value)); + break; + + case GAIM_TYPE_STRING: + return newSVGChar(gaim_value_get_string(value)); + break; + + case GAIM_TYPE_POINTER: + return newSViv((IV)gaim_value_get_pointer(value)); + break; + + case GAIM_TYPE_BOXED: + if (!strcmp(gaim_value_get_specific_type(value), "SV")) + { + SV *sv = (SV *)gaim_perl_get_boxed(value); + + return (sv == NULL ? &PL_sv_undef : sv); + } + + /* Uh.. I dunno. Try this? */ + return sv_2mortal(gaim_perl_bless_object( + gaim_perl_get_boxed(value), + gaim_value_get_specific_type(value))); + + default: + return FALSE; + } + + return TRUE; +} +#endif + +static SV * +gaim_perl_sv_from_subtype(const GaimValue *value, void *arg) +{ + const char *stash = NULL; + + switch (gaim_value_get_subtype(value)) + { + case GAIM_SUBTYPE_ACCOUNT: + stash = "Gaim::Account"; + break; + + default: + stash = "Gaim"; /* ? */ + } + + return sv_2mortal(gaim_perl_bless_object(arg, stash)); +} + +SV * +gaim_perl_sv_from_vargs(const GaimValue *value, va_list args) +{ + switch (gaim_value_get_type(value)) + { + case GAIM_TYPE_SUBTYPE: + return gaim_perl_sv_from_subtype(value, va_arg(args, void *)); + + case GAIM_TYPE_BOOLEAN: + return newSViv(va_arg(args, gboolean)); + + case GAIM_TYPE_INT: + return newSViv(va_arg(args, int)); + + case GAIM_TYPE_UINT: + return newSVuv(va_arg(args, unsigned int)); + + case GAIM_TYPE_LONG: + return newSViv(va_arg(args, long)); + + case GAIM_TYPE_ULONG: + return newSVuv(va_arg(args, unsigned long)); + + case GAIM_TYPE_INT64: + return newSViv(va_arg(args, gint64)); + + case GAIM_TYPE_UINT64: + return newSVuv(va_arg(args, guint64)); + + case GAIM_TYPE_STRING: + return newSVGChar(va_arg(args, char *)); + + case GAIM_TYPE_POINTER: + return newSViv((IV)va_arg(args, void *)); + + case GAIM_TYPE_BOXED: + /* Uh.. I dunno. Try this? */ + return sv_2mortal(gaim_perl_bless_object( + va_arg(args, void *), + gaim_value_get_specific_type(value))); + + default: + /* If this happens, things are going to get screwed up... */ + return NULL; + } +} diff -r cb00e9647033 -r f6c2a7b5afa7 plugins/perl/perl-common.h --- a/plugins/perl/perl-common.h Thu Aug 21 23:26:13 2003 +0000 +++ b/plugins/perl/perl-common.h Thu Aug 21 23:41:52 2003 +0000 @@ -6,6 +6,8 @@ #include #include +#include "value.h" + #define is_hvref(o) \ ((o) && SvROK(o) && SvRV(o) && (SvTYPE(SvRV(o)) == SVt_PVHV)) @@ -18,6 +20,8 @@ gaim_perl_callXS(boot_Gaim__##x, cv, mark); \ } +SV *newSVGChar(const char *str); + void gaim_perl_callXS(void (*subaddr)(pTHX_ CV *cv), CV *cv, SV **mark); void gaim_perl_bless_plain(const char *stash, void *object); SV *gaim_perl_bless_object(void *object, const char *stash); @@ -26,4 +30,11 @@ int execute_perl(const char *function, int argc, char **args); +#if 0 +gboolean gaim_perl_value_from_sv(GaimValue *value, SV *sv); +SV *gaim_perl_sv_from_value(const GaimValue *value); +#endif + +SV *gaim_perl_sv_from_vargs(const GaimValue *value, va_list args); + #endif /* _GAIM_PERL_COMMON_H_ */ diff -r cb00e9647033 -r f6c2a7b5afa7 plugins/perl/perl-handlers.c --- a/plugins/perl/perl-handlers.c Thu Aug 21 23:26:13 2003 +0000 +++ b/plugins/perl/perl-handlers.c Thu Aug 21 23:41:52 2003 +0000 @@ -55,21 +55,35 @@ perl_signal_cb(va_list args, void *data) { GaimPerlSignalHandler *handler = (GaimPerlSignalHandler *)data; - void *arg; void *ret_val = NULL; + int i; int count; + int value_count; + GaimValue *ret_value, **values; dSP; ENTER; SAVETMPS; PUSHMARK(sp); - while ((arg = va_arg(args, void *)) != NULL) - XPUSHs((SV *)arg); + gaim_signal_get_values(handler->instance, handler->signal, + &ret_value, &value_count, &values); + + for (i = 0; i < value_count; i++) + { + SV *sv = gaim_perl_sv_from_vargs(values[i], args); + gaim_debug(GAIM_DEBUG_INFO, "perl", "Pushing arg %p\n", sv); + + XPUSHs(sv); + } + + gaim_debug(GAIM_DEBUG_INFO, "perl", "Pushing data %p\n", handler->data); XPUSHs((SV *)handler->data); PUTBACK; + gaim_debug(GAIM_DEBUG_INFO, "perl", "Calling handler %s\n", + handler->func); count = call_pv(handler->func, G_EVAL | G_SCALAR); SPAGAIN;