# HG changeset patch # User Sadrul Habib Chowdhury # Date 1208917779 0 # Node ID 3a41eb4576058fad2eae48546e10b04664287c38 # Parent 01b5c9ed85e7b84e842f6ce9c8343b71bcc4b851 Use the same fix for Purple::Util::fetch_url (from 4b6378d5e) for Purple::Request:: functions as well. This allows the callbacks to be specified both as coderefs or as strings (name of the callback function). diff -r 01b5c9ed85e7 -r 3a41eb457605 libpurple/plugins/perl/common/Request.xs --- a/libpurple/plugins/perl/common/Request.xs Tue Apr 22 16:47:11 2008 +0000 +++ b/libpurple/plugins/perl/common/Request.xs Wed Apr 23 02:29:39 2008 +0000 @@ -15,10 +15,20 @@ typedef struct { - char *cancel_cb; - char *ok_cb; + SV *ok_fun; + SV *cancel_fun; } PurplePerlRequestData; +static void +purple_perl_request_data_free(PurplePerlRequestData *ppr) +{ + if (ppr->ok_fun) + SvREFCNT_dec(ppr->ok_fun); + if (ppr->cancel_fun) + SvREFCNT_dec(ppr->cancel_fun); + g_free(ppr); +} + /********************************************************/ /* */ /* Callback function that calls a perl subroutine */ @@ -39,23 +49,19 @@ XPUSHs(purple_perl_bless_object(fields, "Purple::Request::Fields")); PUTBACK; - - call_pv(gpr->ok_cb, G_EVAL | G_SCALAR); + call_sv(gpr->ok_fun, G_EVAL | G_SCALAR); SPAGAIN; PUTBACK; FREETMPS; LEAVE; - g_free(gpr->ok_cb); - g_free(gpr->cancel_cb); - g_free(gpr); + purple_perl_request_data_free(gpr); } static void purple_perl_request_cancel_cb(void * data, PurpleRequestFields *fields) { - PurplePerlRequestData *gpr = (PurplePerlRequestData *)data; dSP; @@ -65,16 +71,14 @@ XPUSHs(purple_perl_bless_object(fields, "Purple::Request::Fields")); PUTBACK; - call_pv(gpr->cancel_cb, G_EVAL | G_SCALAR); + call_sv(gpr->cancel_fun, G_EVAL | G_SCALAR); SPAGAIN; PUTBACK; FREETMPS; LEAVE; - g_free(gpr->ok_cb); - g_free(gpr->cancel_cb); - g_free(gpr); + purple_perl_request_data_free(gpr); } MODULE = Purple::Request PACKAGE = Purple::Request PREFIX = purple_request_ @@ -131,14 +135,13 @@ SV * cancel_cb CODE: PurplePerlRequestData *gpr; - STRLEN len; char *basename; basename = g_path_get_basename(handle->path); purple_perl_normalize_script_name(basename); gpr = g_new(PurplePerlRequestData, 1); - gpr->ok_cb = g_strdup_printf("Purple::Script::%s::%s", basename, SvPV(ok_cb, len)); - gpr->cancel_cb = g_strdup_printf("Purple::Script::%s::%s", basename, SvPV(cancel_cb, len)); + gpr->ok_fun = purple_perl_sv_from_fun(handle, ok_cb); + gpr->cancel_fun = purple_perl_sv_from_fun(handle, cancel_cb); g_free(basename); RETVAL = purple_request_input(handle, title, primary, secondary, default_value, multiline, masked, hint, ok_text, G_CALLBACK(purple_perl_request_ok_cb), cancel_text, G_CALLBACK(purple_perl_request_cancel_cb), NULL, NULL, NULL, gpr); @@ -155,14 +158,13 @@ SV * cancel_cb CODE: PurplePerlRequestData *gpr; - STRLEN len; char *basename; basename = g_path_get_basename(handle->path); purple_perl_normalize_script_name(basename); gpr = g_new(PurplePerlRequestData, 1); - gpr->ok_cb = g_strdup_printf("Purple::Script::%s::%s", basename, SvPV(ok_cb, len)); - gpr->cancel_cb = g_strdup_printf("Purple::Script::%s::%s", basename, SvPV(cancel_cb, len)); + gpr->ok_fun = purple_perl_sv_from_fun(handle, ok_cb); + gpr->cancel_fun = purple_perl_sv_from_fun(handle, cancel_cb); g_free(basename); RETVAL = purple_request_file(handle, title, filename, savedialog, G_CALLBACK(purple_perl_request_ok_cb), G_CALLBACK(purple_perl_request_cancel_cb), NULL, NULL, NULL, gpr); @@ -182,14 +184,13 @@ SV * cancel_cb CODE: PurplePerlRequestData *gpr; - STRLEN len; char *basename; basename = g_path_get_basename(handle->path); purple_perl_normalize_script_name(basename); gpr = g_new(PurplePerlRequestData, 1); - gpr->ok_cb = g_strdup_printf("Purple::Script::%s::%s", basename, SvPV(ok_cb, len)); - gpr->cancel_cb = g_strdup_printf("Purple::Script::%s::%s", basename, SvPV(cancel_cb, len)); + gpr->ok_fun = purple_perl_sv_from_fun(handle, ok_cb); + gpr->cancel_fun = purple_perl_sv_from_fun(handle, cancel_cb); g_free(basename); RETVAL = purple_request_fields(handle, title, primary, secondary, fields, ok_text, G_CALLBACK(purple_perl_request_ok_cb), cancel_text, G_CALLBACK(purple_perl_request_cancel_cb), NULL, NULL, NULL, gpr); diff -r 01b5c9ed85e7 -r 3a41eb457605 libpurple/plugins/perl/common/Util.xs --- a/libpurple/plugins/perl/common/Util.xs Tue Apr 22 16:47:11 2008 +0000 +++ b/libpurple/plugins/perl/common/Util.xs Wed Apr 23 02:29:39 2008 +0000 @@ -257,29 +257,13 @@ gboolean http11 SV * cb CODE: - SV *sv = NULL; - - - 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"); - } + SV *sv = purple_perl_sv_from_fun(plugin, cb); if (sv != NULL) { purple_util_fetch_url(url, full, user_agent, http11, purple_perl_util_url_cb, sv); + } else { + purple_debug_warning("perl", "Callback not a valid type, only strings and coderefs allowed in purple_util_fetch_url.\n"); } void diff -r 01b5c9ed85e7 -r 3a41eb457605 libpurple/plugins/perl/perl-common.c --- 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; +} + diff -r 01b5c9ed85e7 -r 3a41eb457605 libpurple/plugins/perl/perl-common.h --- a/libpurple/plugins/perl/perl-common.h Tue Apr 22 16:47:11 2008 +0000 +++ b/libpurple/plugins/perl/perl-common.h Wed Apr 23 02:29:39 2008 +0000 @@ -67,5 +67,5 @@ void *purple_perl_data_from_sv(PurpleValue *value, SV *sv); SV *purple_perl_sv_from_vargs(const PurpleValue *value, va_list *args, void ***copy_arg); - +SV *purple_perl_sv_from_fun(PurplePlugin *plugin, SV *callback); #endif /* _PURPLE_PERL_COMMON_H_ */