Mercurial > pidgin

changeset 6921:11d05ddf30a3

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
[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 <tailor@pidgin.im>
author Christian Hammond <chipx86@chipx86.com>
date Wed, 24 Sep 2003 00:52:16 +0000
parents 13f78c350cd3
children 1d994e9b81f9
files plugins/perl/perl-common.c plugins/perl/perl-common.h plugins/perl/perl-handlers.c
diffstat 3 files changed, 86 insertions(+), 17 deletions(-) [+]
line wrap: on
line diff
--- 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)
--- 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_ */
--- 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, &copy_args[i]);
+		sv_args[i] = sv_2mortal(gaim_perl_sv_from_vargs(values[i],
+														&args, &copy_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;