Changes in perlconfig.c [b9517cf:7dcef03]

File:

• perlconfig.c (modified) (11 diffs)

perlconfig.c

@@ -75 +75 @@
   const char *type;
   char *ptr, *utype, *blessas;
-  int i, j;
+  const char *f;
+  int i;
   const owl_pair *pair;
   const owl_filter *wrap;
@@ -91 +92 @@
                                       owl_new_sv(owl_message_get_##field(m)), 0)
 
-  if (owl_message_get_notice(m)) {
+  if (owl_message_is_type_zephyr(m) && owl_message_is_direction_in(m)) {
     /* Handle zephyr-specific fields... */
-    AV *av_zfields;
-
-    av_zfields = newAV();
-    j=owl_zephyr_get_num_fields(owl_message_get_notice(m));
-    for (i=0; i<j; i++) {
-      ptr=owl_zephyr_get_field_as_utf8(owl_message_get_notice(m), i+1);
-      av_push(av_zfields, owl_new_sv(ptr));
-      g_free(ptr);
+    AV *av_zfields = newAV();
+    if (owl_message_get_notice(m)) {
+      for (f = owl_zephyr_first_raw_field(owl_message_get_notice(m)); f != NULL;
+           f = owl_zephyr_next_raw_field(owl_message_get_notice(m), f)) {
+        ptr = owl_zephyr_field_as_utf8(owl_message_get_notice(m), f);
+        av_push(av_zfields, owl_new_sv(ptr));
+        g_free(ptr);
+      }
+      (void)hv_store(h, "auth", strlen("auth"),
+                     owl_new_sv(owl_zephyr_get_authstr(owl_message_get_notice(m))), 0);
+    } else {
+      /* Incoming zephyrs without a ZNotice_t are pseudo-logins. To appease
+       * existing styles, put in bogus 'auth' and 'fields' keys. */
+      (void)hv_store(h, "auth", strlen("auth"), owl_new_sv("NO"), 0);
     }
     (void)hv_store(h, "fields", strlen("fields"), newRV_noinc((SV*)av_zfields), 0);
-
-    (void)hv_store(h, "auth", strlen("auth"), 
-                   owl_new_sv(owl_zephyr_get_authstr(owl_message_get_notice(m))),0);
   }
 
@@ -184 +188 @@
   hash = (HV*)SvRV(msg);
 
-  m = g_new(owl_message, 1);
+  m = g_slice_new(owl_message);
   owl_message_init(m);
 
@@ -224 +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;
 }
@@ -273 +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;
 }
@@ -327 +287 @@
   char *err;
   const char *args[4] = {"", "-e", "0;", NULL};
+  const char *dlerr;
   AV *inc;
   char *path;
@@ -375 +336 @@
   }
 
-  sv_setpv(get_sv("BarnOwl::VERSION", TRUE), OWL_VERSION_STRING);
+  sv_setpv(get_sv("BarnOwl::VERSION", TRUE), version);
 
   /* Add the system lib path to @INC */
@@ -384 +345 @@
   g_free(path);
 
+  /* Load up perl-Glib. */
+  eval_pv("use Glib;", FALSE);
+
+  /* Now, before BarnOwl tries to use them, get the relevant function pointers out. */
+  dlerr = owl_closure_init();
+  if (dlerr) {
+    return g_strdup(dlerr);
+  }
+
+  /* And now it's safe to import BarnOwl. */
   eval_pv("use BarnOwl;", FALSE);
 
@@ -455 +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
+                ,
+                );
+}
+
+CALLER_OWN char *owl_perlconfig_perl_call(const char *method, int argc, const char *const *argv)
+{
+  SV *rv;
+  char *out = NULL;
+  int i;
+  OWL_PERL_CALL(call_pv(method, 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;
+}
+
+int owl_perlconfig_perl_call_int(const char *method, int argc, const char *const *argv)
+{
+  SV *rv;
+  int ret = -1;
+  int i;
+  OWL_PERL_CALL(call_pv(method, G_SCALAR|G_EVAL)
+                ,
+                OWL_PERL_PUSH_ARGS(i, argc, argv);
+                ,
+                "Perl Error: '%s'"
+                ,
+                false
+                ,
+                false
+                ,
+                rv = POPs;
+                if (rv && SvIOK(rv))
+                  ret = SvIV(rv);
+                );
+  return ret;
+}
+
+bool owl_perlconfig_perl_call_bool(const char *method, int argc, const char *const *argv)
+{
+  SV *rv;
+  bool ret = false;
+  int i;
+  OWL_PERL_CALL(call_pv(method, G_SCALAR|G_EVAL)
+                ,
+                OWL_PERL_PUSH_ARGS(i, argc, argv);
+                ,
+                "Perl Error: '%s'"
+                ,
+                false
+                ,
+                false
+                ,
+                rv = POPs;
+                if (rv)
+                  ret = SvTRUE(rv);
+                );
+  return ret;
+}
+
+void owl_perlconfig_perl_call_norv(const char *method, int argc, const char *const *argv)
+{
+  int i;
+  OWL_PERL_CALL(call_pv(method, G_DISCARD|G_EVAL)
+                ,
+                OWL_PERL_PUSH_ARGS(i, argc, argv);
+                ,
+                "Perl Error: '%s'"
+                ,
+                false
+                ,
+                true
+                ,
+                );
 }
 
@@ -479 +524 @@
 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;
 }
 
@@ -520 +550 @@
 }
 
-void owl_perlconfig_edit_callback(owl_editwin *e)
+void owl_perlconfig_edit_callback(owl_editwin *e, bool success)
 {
   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));
-  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
+                ,
+                );
 }