Changeset 92ffd89 for perlconfig.c

Timestamp:

Jun 22, 2013, 12:36:16 PM (11 years ago)

Author:

Jason Gross <jgross@mit.edu>

Branches:

master, release-1.10

Children:

96d80e9

Parents:

1b17f50

git-author:

Jason Gross <jgross@mit.edu> (09/21/11 14:45:34)

git-committer:

Jason Gross <jgross@mit.edu> (06/22/13 12:36:16)

Message:

Refactor perl calls through a single method

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.

File:

• perlconfig.c (modified) (5 diffs)

perlconfig.c

@@ -228 +228 @@
 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) ;
+  SV *msgref, *rv;
+  char *out = NULL;
+
   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();
-  }
-
-  srv = POPs;
-
-  if (srv) {
-    out = g_strdup(SvPV_nolen(srv));
-  } else {
-    out = NULL;
-  }
-  
-  PUTBACK ;
-  FREETMPS ;
-  LEAVE ;
-
+
+  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;
 }
@@ -277 +256 @@
 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;
 }
@@ -470 +426 @@
 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
+                ,
+                );
 }
 
@@ -494 +442 @@
 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;
 }
 
@@ -538 +471 @@
 {
   SV *cb = owl_editwin_get_cbdata(e);
-  SV *text;
-  dSP;
-
-  if(cb == NULL) {
+  SV *text = owl_new_sv(owl_editwin_get_text(e));
+
+  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
+                ,
+                );
 }