# HG changeset patch # User Christian Hammond # Date 1064364736 0 # Node ID 11d05ddf30a33b08ec1cfbde68ffad03ee81beed # Parent 13f78c350cd3caaaa35706ae48706036dab3a2b8 [gaim-migrate @ 7468] Eh, okay, some more new perl code. You still can't modify signal params, but this is more correct and less leaky. committer: Tailor Script diff -r 13f78c350cd3 -r 11d05ddf30a3 plugins/perl/perl-common.c --- a/plugins/perl/perl-common.c Wed Sep 24 00:03:08 2003 +0000 +++ b/plugins/perl/perl-common.c Wed Sep 24 00:52:16 2003 +0000 @@ -370,7 +370,7 @@ case GAIM_TYPE_ULONG: return (void *)SvUV(sv); case GAIM_TYPE_INT64: return (void *)SvIV(sv); case GAIM_TYPE_UINT64: return (void *)SvUV(sv); - case GAIM_TYPE_STRING: return (void *)SvPV(sv, na); + case GAIM_TYPE_STRING: return g_strdup((void *)SvPV(sv, na)); case GAIM_TYPE_POINTER: return (void *)SvIV(sv); case GAIM_TYPE_BOXED: return (void *)SvIV(sv); @@ -407,7 +407,7 @@ SV * gaim_perl_sv_from_vargs(const GaimValue *value, va_list *args, - void **copy_arg) + void ***copy_arg) { if (gaim_value_is_outgoing(value)) { @@ -420,49 +420,50 @@ return gaim_perl_sv_from_subtype(value, *(void **)*copy_arg); case GAIM_TYPE_BOOLEAN: - if ((*copy_arg = va_arg(*args, gboolean *)) == NULL) + if ((*copy_arg = (void *)va_arg(*args, gboolean *)) == NULL) return &PL_sv_undef; return newSViv(*(gboolean *)*copy_arg); case GAIM_TYPE_INT: - if ((*copy_arg = va_arg(*args, int *)) == NULL) + if ((*copy_arg = (void *)va_arg(*args, int *)) == NULL) return &PL_sv_undef; return newSViv(*(int *)*copy_arg); case GAIM_TYPE_UINT: - if ((*copy_arg = va_arg(*args, unsigned int *)) == NULL) + if ((*copy_arg = (void *)va_arg(*args, unsigned int *)) == NULL) return &PL_sv_undef; return newSVuv(*(unsigned int *)*copy_arg); case GAIM_TYPE_LONG: - if ((*copy_arg = va_arg(*args, long *)) == NULL) + if ((*copy_arg = (void *)va_arg(*args, long *)) == NULL) return &PL_sv_undef; return newSViv(*(long *)*copy_arg); case GAIM_TYPE_ULONG: - if ((*copy_arg = va_arg(*args, unsigned long *)) == NULL) + if ((*copy_arg = (void *)va_arg(*args, + unsigned long *)) == NULL) return &PL_sv_undef; return newSVuv(*(unsigned long *)*copy_arg); case GAIM_TYPE_INT64: - if ((*copy_arg = va_arg(*args, gint64 *)) == NULL) + if ((*copy_arg = (void *)va_arg(*args, gint64 *)) == NULL) return &PL_sv_undef; return newSViv(*(gint64 *)*copy_arg); case GAIM_TYPE_UINT64: - if ((*copy_arg = va_arg(*args, guint64 *)) == NULL) + if ((*copy_arg = (void *)va_arg(*args, guint64 *)) == NULL) return &PL_sv_undef; return newSVuv(*(guint64 *)*copy_arg); case GAIM_TYPE_STRING: - if ((*copy_arg = va_arg(*args, char **)) == NULL) + if ((*copy_arg = (void *)va_arg(*args, char **)) == NULL) return &PL_sv_undef; return newSVGChar(*(char **)*copy_arg); @@ -544,7 +545,7 @@ if ((*copy_arg = (void *)va_arg(*args, char *)) == NULL) return &PL_sv_undef; - return newSVGChar(*copy_arg); + return newSVGChar(*(char **)*copy_arg); case GAIM_TYPE_POINTER: if ((*copy_arg = (void *)va_arg(*args, void *)) == NULL) diff -r 13f78c350cd3 -r 11d05ddf30a3 plugins/perl/perl-common.h --- a/plugins/perl/perl-common.h Wed Sep 24 00:03:08 2003 +0000 +++ b/plugins/perl/perl-common.h Wed Sep 24 00:52:16 2003 +0000 @@ -40,6 +40,6 @@ void *gaim_perl_data_from_sv(GaimValue *value, SV *sv); SV *gaim_perl_sv_from_vargs(const GaimValue *value, va_list *args, - void **copy_arg); + void ***copy_arg); #endif /* _GAIM_PERL_COMMON_H_ */ diff -r 13f78c350cd3 -r 11d05ddf30a3 plugins/perl/perl-handlers.c --- a/plugins/perl/perl-handlers.c Wed Sep 24 00:03:08 2003 +0000 +++ b/plugins/perl/perl-handlers.c Wed Sep 24 00:52:16 2003 +0000 @@ -61,6 +61,8 @@ return 0; } +typedef void *DATATYPE; + static void * perl_signal_cb(va_list args, void *data) { @@ -71,7 +73,8 @@ int value_count; GaimValue *ret_value, **values; SV **sv_args; - void **copy_args; + DATATYPE **copy_args; + STRLEN na; dSP; ENTER; @@ -81,12 +84,13 @@ gaim_signal_get_values(handler->instance, handler->signal, &ret_value, &value_count, &values); - sv_args = g_new(SV *, value_count); - copy_args = g_new(void *, value_count); + sv_args = g_new(SV *, value_count); + copy_args = g_new(void **, value_count); for (i = 0; i < value_count; i++) { - sv_args[i] = gaim_perl_sv_from_vargs(values[i], &args, ©_args[i]); + sv_args[i] = sv_2mortal(gaim_perl_sv_from_vargs(values[i], + &args, ©_args[i])); XPUSHs(sv_args[i]); } @@ -97,7 +101,7 @@ if (ret_value != NULL) { - count = call_sv(handler->callback, G_SCALAR); + count = call_sv(handler->callback, G_EVAL | G_SCALAR); SPAGAIN; @@ -107,18 +111,82 @@ ret_val = gaim_perl_data_from_sv(ret_value, POPs); } else + { call_sv(handler->callback, G_SCALAR); + SPAGAIN; + } + + if (SvTRUE(ERRSV)) + { + gaim_debug_error("perl", "Perl function exited abnormally: %s\n", + SvPV(ERRSV, na)); + } + /* See if any parameters changed. */ for (i = 0; i < value_count; i++) { if (gaim_value_is_outgoing(values[i])) { + switch (gaim_value_get_type(values[i])) + { + case GAIM_TYPE_BOOLEAN: + *((gboolean *)copy_args[i]) = SvIV(sv_args[i]); + break; + + case GAIM_TYPE_INT: + *((int *)copy_args[i]) = SvIV(sv_args[i]); + break; + + case GAIM_TYPE_UINT: + *((unsigned int *)copy_args[i]) = SvUV(sv_args[i]); + break; + + case GAIM_TYPE_LONG: + *((long *)copy_args[i]) = SvIV(sv_args[i]); + break; + + case GAIM_TYPE_ULONG: + *((unsigned long *)copy_args[i]) = SvUV(sv_args[i]); + break; + + case GAIM_TYPE_INT64: + *((gint64 *)copy_args[i]) = SvIV(sv_args[i]); + break; + + case GAIM_TYPE_UINT64: + *((guint64 *)copy_args[i]) = SvUV(sv_args[i]); + break; + + case GAIM_TYPE_STRING: + gaim_debug_misc("perl", "Copying over %s\n", + *((char **)copy_args[i])); + g_free(*((char **)copy_args[i])); + *((char **)copy_args[i]) = g_strdup(SvPV(sv_args[i], na)); + gaim_debug_misc("perl", "New value: %s\n", + *((char **)copy_args[i])); + break; + + case GAIM_TYPE_POINTER: + *((void **)copy_args[i]) = (void *)SvIV(sv_args[i]); + break; + + case GAIM_TYPE_BOXED: + *((void **)copy_args[i]) = (void *)SvIV(sv_args[i]); + break; + + default: + break; + } + +#if 0 *((void **)copy_args[i]) = gaim_perl_data_from_sv(values[i], sv_args[i]); +#endif } } + PUTBACK; FREETMPS; LEAVE;