pidgin: 4b6378d5: Fix Purple::Util::fetch_url to correctly...

[deryni at pidgin.im]

-----------------------------------------------------------------
Revision: 4b6378d5ea4138f0dfc97e3fd75b7026949491b1
Ancestor: 595cd288a660326477660b9d9251785e57aaaebe
Author: deryni at pidgin.im
Date: 2008-04-19T04:52:13
Branch: im.pidgin.pidgin
URL: http://d.pidgin.im/viewmtn/revision/info/4b6378d5ea4138f0dfc97e3fd75b7026949491b1

Modified files:
        libpurple/plugins/perl/common/Util.xs

ChangeLog: 

Fix Purple::Util::fetch_url to correctly accept a callback in any of the
following forms \&funref, sub {...}, or "fun", instead of just accepting
"fun". While I was at it, I cleaned up the code a bit, this should allocate a
little less memory every time now and provide a little more useful error
reporting for invalid callback data.

-------------- next part --------------
============================================================
--- libpurple/plugins/perl/common/Util.xs	5e95d737fbd5845bab75a4fd5a99772dfdab8285
+++ libpurple/plugins/perl/common/Util.xs	19edeb0d7ba209988b79b448ac676c349d54a03e
@@ -1,11 +1,11 @@
 #include "module.h"
 
-typedef struct {
-	char *cb;
-} PurplePerlUrlData;
-
-static void purple_perl_util_url_cb(PurpleUtilFetchUrlData *url_data, void *user_data, const gchar *url_text, size_t size, const gchar *error_message) {
-	PurplePerlUrlData *gpr = (PurplePerlUrlData *)user_data;
+static void
+purple_perl_util_url_cb(PurpleUtilFetchUrlData *url_data, void *user_data,
+                        const gchar *url_text, size_t size,
+                        const gchar *error_message)
+{
+	SV *sv = (SV *)user_data;
 	dSP;
 	ENTER;
 	SAVETMPS;
@@ -14,11 +14,12 @@ static void purple_perl_util_url_cb(Purp
 	XPUSHs(sv_2mortal(newSVpvn(url_text, size)));
 	PUTBACK;
 
-	call_pv(gpr->cb, G_EVAL | G_SCALAR);
+	call_sv(sv, G_EVAL | G_SCALAR);
 	SPAGAIN;
 
-	g_free(gpr->cb);
-	g_free(gpr);
+	/* XXX Make sure this destroys it correctly and that we don't want
+	 * something like sv_2mortal(sv) or something else here instead. */
+	SvREFCNT_dec(sv);
 
 	PUTBACK;
 	FREETMPS;
@@ -248,26 +249,39 @@ void
 PROTOTYPES: ENABLE
 
 void
-purple_util_fetch_url(handle, url, full, user_agent, http11, cb)
-	Purple::Plugin handle
+purple_util_fetch_url(plugin, url, full, user_agent, http11, cb)
+	Purple::Plugin plugin
 	const char *url
 	gboolean full
 	const char *user_agent
 	gboolean http11
 	SV * cb
 CODE:
-	PurplePerlUrlData *gpr;
-	STRLEN len;
-	char *basename;
+	SV *sv = NULL;
 
-	basename = g_path_get_basename(handle->path);
-	purple_perl_normalize_script_name(basename);
-	gpr = g_new(PurplePerlUrlData, 1);
 
-	gpr->cb = g_strdup_printf("Purple::Script::%s::%s", basename, SvPV(cb, len));
-	g_free(basename);
-	purple_util_fetch_url(url, full, user_agent, http11, purple_perl_util_url_cb, gpr);
+	if (SvTYPE(cb) == SVt_RV) {
+		SV *cbsv = SvRV(cb);
 
+		if (SvTYPE(cbsv) == SVt_PVCV) {
+			sv = newSVsv(cb);
+		} else {
+			purple_debug_warning("perl", "Callback not a valid coderef in purple_util_fetch_url.\n");
+		}
+	} else if (SvTYPE(cb) == SVt_PV) {
+		PurplePerlScript *gps;
+
+		gps = (PurplePerlScript *)PURPLE_PLUGIN_LOADER_INFO(plugin);
+		sv = newSVpvf("%s::%s", gps->package, SvPV_nolen(cb));
+	} else {
+		purple_debug_warning("perl", "Callback not a valid type, only strings and coderefs allowed in purple_util_fetch_url.\n");
+	}
+
+	if (sv != NULL) {
+		purple_util_fetch_url(url, full, user_agent, http11,
+		                      purple_perl_util_url_cb, sv);
+	}
+
 void
 purple_util_set_user_dir(dir)
 	const char *dir