Changeset 6922edd for perlconfig.c

Timestamp:

Oct 26, 2006, 11:14:41 AM (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:

4c46dfd

Parents:

bc220b2

Message:

Adding the ability to install real commands from perl.

File:

• perlconfig.c (modified) (3 diffs)

perlconfig.c

@@ -7 +7 @@
 #define OWL_PERL
 #include "owl.h"
-#include <perl.h>
-#include "XSUB.h"
 
 static const char fileIdent[] = "$Id$";
@@ -16 +14 @@
 extern XS(boot_owl);
 extern XS(boot_DynaLoader);
-extern XS(boot_DBI);
+// extern XS(boot_DBI);
 
 static void owl_perl_xs_init(pTHX)
@@ -337 +335 @@
   }
 }
+
+char *owl_perlconfig_perlcmd(owl_cmd *cmd, int argc, char **argv)
+{
+  int i, count;
+  char * ret = NULL;
+  STRLEN n_a;
+  dSP;
+
+  ENTER;
+  SAVETMPS;
+
+  PUSHMARK(SP);
+  for(i=0;i<argc;i++) {
+    XPUSHs(sv_2mortal(newSVpv(argv[i], 0)));
+  }
+  PUTBACK;
+
+  count = call_sv(cmd->cmd_perl, G_SCALAR|G_EVAL);
+
+  SPAGAIN;
+
+  if(SvTRUE(ERRSV)) {
+    owl_function_error("Error: %s", SvPV(ERRSV, n_a));
+    POPs;
+  } else {
+    if(count != 1)
+      croak("Perl command %s returned more than one value!", cmd->name);
+    SV * rv = POPs;
+    if(SvTRUE(rv)) {
+      ret = owl_strdup(SvPV(rv, n_a));
+    }
+  }
+
+  FREETMPS;
+  LEAVE;
+
+  return ret;
+}
+
+void owl_perlconfig_cmd_free(owl_cmd *cmd)
+{
+  SvREFCNT_dec(cmd);
+}