Changeset 6922edd

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.

Files:

• cmd.c (modified) (3 diffs)
• owl.h (modified) (3 diffs)
• perlconfig.c (modified) (3 diffs)
• perlglue.xs (modified) (2 diffs)
• perlwrap.pm (modified) (1 diff)

cmd.c

@@ -55 +55 @@
   owl_dict_insert_element(cd, cmd->name, (void*)cmd, (void(*)(void*))owl_cmd_free);    
   return(0);
+}
+
+int owl_cmddict_add_cmd(owl_cmddict *cd, owl_cmd * cmd) {
+  owl_cmd * newcmd = owl_malloc(sizeof(owl_cmd));
+  if(owl_cmd_create_from_template(newcmd, cmd) < 0) {
+    owl_free(newcmd);
+    return -1;
+  }
+  owl_function_debugmsg("Add cmd %s", cmd->name);
+  return owl_dict_insert_element(cd, newcmd->name, (void*)newcmd, (void(*)(void*))owl_cmd_free);
 }
 
@@ -118 +128 @@
   if (cmd->usage) owl_free(cmd->usage);
   if (cmd->description) owl_free(cmd->description);
+  if (cmd->cmd_aliased_to) owl_free(cmd->cmd_aliased_to);
+  if (cmd->cmd_perl) owl_perlconfig_cmd_free(cmd);
 }
 
@@ -187 +199 @@
   } else if (cmd->cmd_ctxi_fn) {
     cmd->cmd_ctxi_fn(owl_context_get_data(ctx), ival);
+  } else if (cmd->cmd_perl) {
+    return owl_perlconfig_perlcmd(cmd, argc, argv);
   }
 

owl.h

@@ -41 +41 @@
 #define INC_OWL_H
 
-/* Perl and curses don't play nice. */
-#ifndef OWL_PERL
-#include <curses.h>
-#else
-#define WINDOW void
-#endif
-
 #include <sys/param.h>
 #include <EXTERN.h>
@@ -62 +55 @@
 #ifdef HAVE_COM_ERR_H
 #include <com_err.h>
+#endif
+
+/* Perl and curses don't play nice. */
+#ifdef OWL_PERL
+typedef void WINDOW;
+#include <perl.h>
+#include "XSUB.h"
+#else
+#include <curses.h>
+typedef void SV;
 #endif
 
@@ -305 +308 @@
   void (*cmd_ctxv_fn)(void *ctx);               /* takes no args */
   void (*cmd_ctxi_fn)(void *ctx, int i);        /* takes an int as an arg */
+  SV *cmd_perl;                                /* Perl closure that takes a list of args */
 } owl_cmd;
 

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);
+}

perlglue.xs

@@ -5 +5 @@
 #endif
 #include <EXTERN.h>
-#include <perl.h>
-#include <XSUB.h>
 
 #define OWL_PERL
@@ -75 +73 @@
                 if (rv) owl_free(rv);
 
+void
+new_command_internal(name, func, summary, usage, description)
+        char *name
+        SV *func
+        char *summary
+        char *usage
+        char *description
+        PREINIT:
+                owl_cmd cmd;
+        CODE:
+                SvREFCNT_inc(func);
+                cmd.name = name;
+                cmd.cmd_perl = func;
+                cmd.summary = summary;
+                cmd.usage = usage;
+                cmd.description = description;
+                cmd.validctx = OWL_CTX_ANY;
+
+                cmd.cmd_aliased_to = NULL;
+                cmd.cmd_args_fn = NULL;
+                cmd.cmd_v_fn = NULL;
+                cmd.cmd_i_fn = NULL;
+                cmd.cmd_ctxargs_fn = NULL;
+                cmd.cmd_ctxv_fn = NULL;
+                cmd.cmd_ctxi_fn = NULL;
+
+                owl_cmddict_add_cmd(owl_global_get_cmddict(&g), &cmd);

perlwrap.pm

@@ -30 +30 @@
     $called =~ s/.*:://;
     return &owl::command("$called ".join(" ",@_));
+}
+
+=head2 new_command NAME FUNC [{ARGS}]
+
+Add a new owl command. When owl executes the command NAME, FUNC will
+be called with the arguments passed to the command, with NAME as the
+first argument.
+
+ARGS should be a hashref containing any or all of C<summary>,
+C<usage>, or C<description> keys.
+
+=cut
+
+sub new_command {
+    my $name = shift;
+    my $func = shift;
+    my $args = shift || {};
+    my %args = (
+        summary     => undef,
+        usage       => undef,
+        description => undef,
+        %{$args}
+    );
+
+    owl::new_command_internal($name, $func, $args{summary}, $args{usage}, $args{description});
 }