[3326] in BarnOwl Developers
[PATCH 1/5] Refactor perl calls through a single method
daemon@ATHENA.MIT.EDU (Jason Gross)
Sun Jan 13 14:08:20 2013
From: Jason Gross <jgross@MIT.EDU>
To: barnowl-dev@mit.edu
Cc: Jason Gross <jgross@mit.edu>
Date: Sun, 13 Jan 2013 14:07:50 -0500
In-Reply-To: <1358104074-23031-1-git-send-email-jgross@mit.edu>
I don't know the perl/C interface well enough to figure out the best way
to standardize the many variants that we use to call perl code. Perhaps
we should standardize the error messages, and put less knobs on the
boilerplate macro.
---
owl_perl.h | 95 ++++++++++++++----------
perlconfig.c | 231 ++++++++++++++++++++--------------------------------------
style.c | 33 ++++----
3 files changed, 152 insertions(+), 207 deletions(-)
diff --git a/owl_perl.h b/owl_perl.h
index 0f1f711..469c66a 100644
--- a/owl_perl.h
+++ b/owl_perl.h
@@ -3,55 +3,72 @@
#include <stdio.h>
-#define OWL_PERL_VOID_CALL (void)POPs;
+/*
+ * This macro defines a convenience wrapper around the boilerplate
+ * of pushing char * arguments on to the stack for perl calling.
+ *
+ * Arguments are
+ * * i - the counter variable to use, which must be declared prior
+ * to calling this macro
+ * * argc - the number of arguments
+ * * argv - an array of char*s, of length at least argc; the arguments
+ * to push on to the stack
+ */
+#define OWL_PERL_PUSH_ARGS(i, argc, argv) { \
+ for (i = 0; i < argc; i++) { \
+ XPUSHs(sv_2mortal(owl_new_sv(argv[i]))); \
+ } \
+}
/*
* This macro defines a convenience wrapper around the boilerplate of
- * calling a method on a perl object (SV*) from C.
+ * the perlcall methods.
*
* Arguments are
- * * obj - the SV* to call the method on
- * * meth - a char* method name
- * * args - a code block responsible for pushing args (other than the object)
- * * err - a string with a %s format specifier to log in case of error
- * * fatalp - if true, perl errors terminate BarnOwl
- * * ret - a code block executed if the call succeeded
+ * * call - the line of code to make the perl call
+ * * args - a code block responsible for pushing args
+ * * err - a string with a %s format specifier to log in case of error
+ * * fatalp - if true, perl errors terminate BarnOwl
+ * * discardret - should be true if no return is expected
+ * (if the call is passed the flag G_DISCARD or G_VOID)
+ * * ret - a code block executed if the call succeeded
*
* See also: `perldoc perlcall', `perldoc perlapi'
*/
-#define OWL_PERL_CALL_METHOD(obj, meth, args, err, fatalp, ret) { \
- int count; \
- dSP; \
- ENTER; \
- SAVETMPS; \
- PUSHMARK(SP); \
- XPUSHs(obj); \
- {args} \
- PUTBACK; \
- \
- count = call_method(meth, G_SCALAR|G_EVAL); \
- \
- SPAGAIN; \
- \
- if(count != 1) { \
- fprintf(stderr, "perl returned wrong count: %d\n", count); \
- abort(); \
- } \
- if (SvTRUE(ERRSV)) { \
- if(fatalp) { \
- printf(err, SvPV_nolen(ERRSV)); \
- exit(-1); \
- } else { \
- owl_function_error(err, SvPV_nolen(ERRSV)); \
- (void)POPs; \
- sv_setsv(ERRSV, &PL_sv_undef); \
- } \
+#define OWL_PERL_CALL(call, args, err, fatalp, discardret, ret) { \
+ int count; \
+ dSP; \
+ \
+ ENTER; \
+ SAVETMPS; \
+ \
+ PUSHMARK(SP); \
+ {args} \
+ PUTBACK; \
+ \
+ count = call; \
+ \
+ SPAGAIN; \
+ \
+ if (!discardret && count != 1) { \
+ croak("Perl returned wrong count: %d\n", count); \
+ } \
+ \
+ if (SvTRUE(ERRSV)) { \
+ if (fatalp) { \
+ fprintf(stderr, err, SvPV_nolen(ERRSV)); \
+ exit(-1); \
} else { \
- ret; \
+ owl_function_error(err, SvPV_nolen(ERRSV)); \
+ if (!discardret) (void)POPs; \
+ sv_setsv(ERRSV, &PL_sv_undef); \
} \
- PUTBACK; \
- FREETMPS; \
- LEAVE; \
+ } else if (!discardret) { \
+ ret; \
+ } \
+ PUTBACK; \
+ FREETMPS; \
+ LEAVE; \
}
#endif /* INC_BARNOWL_OWL_PERL_H */
diff --git a/perlconfig.c b/perlconfig.c
index ea99fd0..42169ac 100644
--- a/perlconfig.c
+++ b/perlconfig.c
@@ -227,46 +227,25 @@ CALLER_OWN owl_message *owl_perlconfig_hashref2message(SV *msg)
If return value is non-null, caller must free. */
CALLER_OWN char *owl_perlconfig_call_with_message(const char *subname, const owl_message *m)
{
- dSP ;
- int count;
- SV *msgref, *srv;
- char *out;
-
- ENTER ;
- SAVETMPS;
-
- PUSHMARK(SP) ;
- msgref = owl_perlconfig_message2hashref(m);
- XPUSHs(sv_2mortal(msgref));
- PUTBACK ;
-
- count = call_pv(subname, G_SCALAR|G_EVAL);
-
- SPAGAIN ;
-
- if (SvTRUE(ERRSV)) {
- owl_function_error("Perl Error: '%s'", SvPV_nolen(ERRSV));
- /* and clear the error */
- sv_setsv (ERRSV, &PL_sv_undef);
- }
-
- if (count != 1) {
- fprintf(stderr, "bad perl! no biscuit! returned wrong count!\n");
- abort();
- }
+ SV *msgref, *rv;
+ char *out = NULL;
- srv = POPs;
-
- if (srv) {
- out = g_strdup(SvPV_nolen(srv));
- } else {
- out = NULL;
- }
-
- PUTBACK ;
- FREETMPS ;
- LEAVE ;
+ msgref = owl_perlconfig_message2hashref(m);
+ OWL_PERL_CALL((call_pv(subname, G_SCALAR|G_EVAL))
+ ,
+ XPUSHs(sv_2mortal(msgref));
+ ,
+ "Perl Error: '%s'"
+ ,
+ false
+ ,
+ false
+ ,
+ rv = POPs;
+ if (rv && SvPOK(rv))
+ out = g_strdup(SvPV_nolen(rv));
+ );
return out;
}
@@ -276,50 +255,27 @@ CALLER_OWN char *owl_perlconfig_call_with_message(const char *subname, const owl
*/
CALLER_OWN char *owl_perlconfig_message_call_method(const owl_message *m, const char *method, int argc, const char **argv)
{
- dSP;
- unsigned int count, i;
- SV *msgref, *srv;
- char *out;
+ SV *msgref, *rv;
+ char *out = NULL;
+ int i;
msgref = owl_perlconfig_message2hashref(m);
- ENTER;
- SAVETMPS;
-
- PUSHMARK(SP);
- XPUSHs(sv_2mortal(msgref));
- for(i=0;i<argc;i++) {
- XPUSHs(sv_2mortal(owl_new_sv(argv[i])));
- }
- PUTBACK;
-
- count = call_method(method, G_SCALAR|G_EVAL);
-
- SPAGAIN;
-
- if(count != 1) {
- fprintf(stderr, "perl returned wrong count %u\n", count);
- abort();
- }
-
- if (SvTRUE(ERRSV)) {
- owl_function_error("Error: '%s'", SvPV_nolen(ERRSV));
- /* and clear the error */
- sv_setsv (ERRSV, &PL_sv_undef);
- }
-
- srv = POPs;
-
- if (srv) {
- out = g_strdup(SvPV_nolen(srv));
- } else {
- out = NULL;
- }
-
- PUTBACK;
- FREETMPS;
- LEAVE;
-
+ OWL_PERL_CALL(call_method(method, G_SCALAR|G_EVAL)
+ ,
+ XPUSHs(sv_2mortal(msgref));
+ OWL_PERL_PUSH_ARGS(i, argc, argv);
+ ,
+ "Perl Error: '%s'"
+ ,
+ false
+ ,
+ false
+ ,
+ rv = POPs;
+ if (rv && SvPOK(rv))
+ out = g_strdup(SvPV_nolen(rv));
+ );
return out;
}
@@ -458,64 +414,41 @@ void owl_perlconfig_newmsg(const owl_message *m, const char *subname)
void owl_perlconfig_new_command(const char *name)
{
- dSP;
-
- ENTER;
- SAVETMPS;
-
- PUSHMARK(SP);
- XPUSHs(sv_2mortal(owl_new_sv(name)));
- PUTBACK;
-
- call_pv("BarnOwl::Hooks::_new_command", G_VOID|G_EVAL);
-
- SPAGAIN;
-
- if(SvTRUE(ERRSV)) {
- owl_function_error("%s", SvPV_nolen(ERRSV));
- }
-
- FREETMPS;
- LEAVE;
+ OWL_PERL_CALL(call_pv("BarnOwl::Hooks::_new_command", G_VOID|G_EVAL);
+ ,
+ XPUSHs(sv_2mortal(owl_new_sv(name)));
+ ,
+ "Perl Error: '%s'"
+ ,
+ false
+ ,
+ true
+ ,
+ );
}
/* caller must free the result */
CALLER_OWN char *owl_perlconfig_perlcmd(const owl_cmd *cmd, int argc, const char *const *argv)
{
- int i, count;
- char * ret = NULL;
- SV *rv;
- dSP;
-
- ENTER;
- SAVETMPS;
-
- PUSHMARK(SP);
- for(i=0;i<argc;i++) {
- XPUSHs(sv_2mortal(owl_new_sv(argv[i])));
- }
- PUTBACK;
-
- count = call_sv(cmd->cmd_perl, G_SCALAR|G_EVAL);
-
- SPAGAIN;
-
- if(SvTRUE(ERRSV)) {
- owl_function_error("%s", SvPV_nolen(ERRSV));
- (void)POPs;
- } else {
- if(count != 1)
- croak("Perl command %s returned more than one value!", cmd->name);
- rv = POPs;
- if(SvTRUE(rv)) {
- ret = g_strdup(SvPV_nolen(rv));
- }
- }
-
- FREETMPS;
- LEAVE;
-
- return ret;
+ int i;
+ SV* rv;
+ char *out = NULL;
+
+ OWL_PERL_CALL(call_sv(cmd->cmd_perl, G_SCALAR|G_EVAL)
+ ,
+ OWL_PERL_PUSH_ARGS(i, argc, argv);
+ ,
+ "Perl Error: '%s'"
+ ,
+ false
+ ,
+ false
+ ,
+ rv = POPs;
+ if (rv && SvPOK(rv))
+ out = g_strdup(SvPV_nolen(rv));
+ );
+ return out;
}
void owl_perlconfig_cmd_cleanup(owl_cmd *cmd)
@@ -526,31 +459,25 @@ void owl_perlconfig_cmd_cleanup(owl_cmd *cmd)
void owl_perlconfig_edit_callback(owl_editwin *e, bool success)
{
SV *cb = owl_editwin_get_cbdata(e);
- SV *text;
- dSP;
+ SV *text = owl_new_sv(owl_editwin_get_text(e));
- if(cb == NULL) {
+ if (cb == NULL) {
owl_function_error("Perl callback is NULL!");
return;
}
- text = owl_new_sv(owl_editwin_get_text(e));
- ENTER;
- SAVETMPS;
-
- PUSHMARK(SP);
- XPUSHs(sv_2mortal(text));
- XPUSHs(sv_2mortal(newSViv(success)));
- PUTBACK;
-
- call_sv(cb, G_DISCARD|G_EVAL);
-
- if(SvTRUE(ERRSV)) {
- owl_function_error("%s", SvPV_nolen(ERRSV));
- }
-
- FREETMPS;
- LEAVE;
+ OWL_PERL_CALL(call_sv(cb, G_DISCARD|G_EVAL)
+ ,
+ XPUSHs(sv_2mortal(text));
+ XPUSHs(sv_2mortal(newSViv(success)));
+ ,
+ "Perl Error: '%s'"
+ ,
+ false
+ ,
+ true
+ ,
+ );
}
void owl_perlconfig_dec_refcnt(void *data)
diff --git a/style.c b/style.c
index bb2a5b2..6c6cd93 100644
--- a/style.c
+++ b/style.c
@@ -22,14 +22,14 @@ const char *owl_style_get_name(const owl_style *s)
const char *owl_style_get_description(const owl_style *s)
{
SV *sv = NULL;
- OWL_PERL_CALL_METHOD(s->perlobj,
- "description",
- ;,
- "Error in style_get_description: %s",
- 0,
- sv = SvREFCNT_inc(POPs);
- );
- if(sv) {
+ OWL_PERL_CALL(call_method("description", G_SCALAR|G_EVAL),
+ XPUSHs(s->perlobj);,
+ "Error in style_get_description: %s",
+ 0,
+ false,
+ sv = SvREFCNT_inc(POPs);
+ );
+ if (sv) {
return SvPV_nolen(sv_2mortal(sv));
} else {
return "[error getting description]";
@@ -49,15 +49,16 @@ void owl_style_get_formattext(const owl_style *s, owl_fmtext *fm, const owl_mess
SV *sv = NULL;
/* Call the perl object */
- OWL_PERL_CALL_METHOD(s->perlobj,
- "format_message",
- XPUSHs(sv_2mortal(owl_perlconfig_message2hashref(m)));,
- "Error in format_message: %s",
- 0,
- sv = SvREFCNT_inc(POPs);
- );
+ OWL_PERL_CALL(call_method("format_message", G_SCALAR|G_EVAL),
+ XPUSHs(s->perlobj);
+ XPUSHs(sv_2mortal(owl_perlconfig_message2hashref(m)));,
+ "Error in format_message: %s",
+ 0,
+ false,
+ sv = SvREFCNT_inc(POPs);
+ );
- if(sv) {
+ if (sv) {
body = SvPV_nolen(sv);
} else {
body = "<unformatted message>";
--
1.7.2.5
