libpurple/plugins/perl/perl-common.c

changeset 22839
3ee4247ebbbd
parent 17471
fcb31ec08595
child 23915
b62601fd6e7d
--- a/libpurple/plugins/perl/perl-common.c	Tue Apr 22 16:47:11 2008 +0000
+++ b/libpurple/plugins/perl/perl-common.c	Wed Apr 23 02:29:39 2008 +0000
@@ -616,3 +616,26 @@
 
 	return NULL;
 }
+
+SV *purple_perl_sv_from_fun(PurplePlugin *plugin, SV *callback)
+{
+	SV *sv = NULL;
+
+	if (SvTYPE(callback) == SVt_RV) {
+		SV *cbsv = SvRV(callback);
+
+		if (SvTYPE(cbsv) == SVt_PVCV) {
+			sv = newSVsv(callback);
+		}
+	} else if (SvTYPE(callback) == SVt_PV) {
+		PurplePerlScript *gps;
+
+		gps = (PurplePerlScript *)PURPLE_PLUGIN_LOADER_INFO(plugin);
+		sv = newSVpvf("%s::%s", gps->package, SvPV_nolen(callback));
+	} else {
+		purple_debug_warning("perl", "Callback not a valid type, only strings and coderefs allowed.\n");
+	}
+
+	return sv;
+}
+

mercurial