Changeset 57ad328

Timestamp:

Sep 30, 2011, 8:22:50 AM (13 years ago)

Author:

Jason Gross <jgross@mit.edu>

Children:

6df57d4

Parents:

0c71c58

git-author:

Jason Gross <jgross@mit.edu> (06/20/11 15:03:22)

git-committer:

Jason Gross <jgross@mit.edu> (09/30/11 08:22:50)

Message:

Added support for calling perl subs with various return types

File:

• perlconfig.c (modified) (2 diffs)

perlconfig.c

@@ -424 +424 @@
 }
 
-/* caller must free the result */
-CALLER_OWN char *owl_perlconfig_perlcmd(const owl_cmd *cmd, int argc, const char *const *argv)
-{
-  int i;
-  SV* rv;
+CALLER_OWN char *owl_perlconfig_perl_call(const char *method, int argc, const char *const *argv)
+{
+  SV *rv;
   char *out = NULL;
-
-  OWL_PERL_CALL(call_sv(cmd->cmd_perl, G_SCALAR|G_EVAL)
+  int i;
+  OWL_PERL_CALL(call_pv(method, G_SCALAR|G_EVAL)
                 ,
                 OWL_PERL_PUSH_ARGS(i, argc, argv);
@@ -448 +446 @@
 }
 
+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
+                ,
+                );
+}
+
+/* caller must free the result */
+CALLER_OWN char *owl_perlconfig_perlcmd(const owl_cmd *cmd, int argc, const char *const *argv)
+{
+  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)
 {