Changeset 25729b2 for perlconfig.c

Timestamp:

Jan 8, 2007, 4:17:55 PM (18 years ago)

Author:

Nelson Elhage <nelhage@mit.edu>

Branches:

master, barnowl_perlaim, debian, release-1.10, release-1.4, release-1.5, release-1.6, release-1.7, release-1.8, release-1.9

Children:

723f464

Parents:

6beac73

git-author:

Nelson Elhage <nelhage@mit.edu> (01/08/07 15:55:09)

git-committer:

Nelson Elhage <nelhage@mit.edu> (01/08/07 16:17:55)

Message:

Adding basic smartnarrow support for jabber, and infrastructure to
make it extensible.

File:

• perlconfig.c (modified) (1 diff)

perlconfig.c

@@ -161 +161 @@
   return out;
 }
+
+
+/* Calls a method on a perl object representing a message.
+   If the return value is non-null, the caller must free it.
+ */
+char * owl_perlconfig_message_call_method(owl_message *m, char *method, int argc, char ** argv)
+{
+  dSP;
+  unsigned int count, len, i;
+  SV *msgref, *srv;
+  char *out, *preout;
+
+  msgref = owl_perlconfig_message2hashref(m);
+
+  ENTER;
+  SAVETMPS;
+
+  PUSHMARK(SP);
+  XPUSHs(msgref);
+  for(i=0;i<argc;i++) {
+    XPUSHs(sv_2mortal(newSVpv(argv[i], 0)));
+  }
+  PUTBACK;
+
+  count = call_method(method, G_SCALAR|G_KEEPERR|G_EVAL);
+
+  SPAGAIN;
+
+  if(count != 1) {
+    fprintf(stderr, "perl returned wrong count %d\n", count);
+    abort();
+  }
+
+  if (SvTRUE(ERRSV)) {
+    STRLEN n_a;
+    owl_function_error("Error: '%s'", SvPV(ERRSV, n_a));
+    /* and clear the error */
+    sv_setsv (ERRSV, &PL_sv_undef);
+  }
+
+  srv = POPs;
+
+  if (srv) {
+    preout=SvPV(srv, len);
+    out = owl_malloc(strlen(preout)+1);
+    strncpy(out, preout, len);
+    out[len] = '\0';
+  } else {
+    out = NULL;
+  }
+
+  PUTBACK;
+  FREETMPS;
+  LEAVE;
+
+  return out;
+}
+
 
 char *owl_perlconfig_readconfig(void)