Changeset 96d80e9

Timestamp:

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

Author:

Jason Gross <jgross@mit.edu>

Branches:

master, release-1.10

Children:

749916e, 4ae24dd, 88e7b2e, 963f0e3, 4f6097e, ea43085, 825953e, 2323e49, f248113

Parents:

92ffd89

git-author:

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

git-committer:

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

Message:

Added support for calling perl subs with various return types

File:

• perlconfig.c (modified) (2 diffs)

perlconfig.c

@@ -439 +439 @@
 }
 
-/* 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);
@@ -463 +461 @@
 }
 
+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)
 {