changeset 6566:f6c2a7b5afa7

[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 <tailor@pidgin.im>
author Christian Hammond <chipx86@chipx86.com>
date Thu, 21 Aug 2003 23:41:52 +0000
parents cb00e9647033
children 6e25e1e08ffb
files plugins/perl/perl-common.c plugins/perl/perl-common.h plugins/perl/perl-handlers.c
diffstat 3 files changed, 238 insertions(+), 10 deletions(-) [+]
line wrap: on
line diff
--- 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;
+	}
+}
--- 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 <perl.h>
 #include <glib.h>
 
+#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_ */
--- 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;