[229] in BarnOwl Developers
[D-O-H] r405 - trunk/owl
daemon@ATHENA.MIT.EDU (nelhage@MIT.EDU)
Thu Oct 29 18:03:55 2009
Resent-From: nelhage@mit.edu
Resent-To: barnowl-dev-mtg@charon.mit.edu
Date: Thu, 26 Oct 2006 11:14:42 -0400
To: dirty-owl-hackers@MIT.EDU
From: nelhage@MIT.EDU
Reply-To: dirty-owl-hackers@MIT.EDU
Author: nelhage
Date: 2006-10-26 11:14:41 -0400 (Thu, 26 Oct 2006)
New Revision: 405
Modified:
trunk/owl/cmd.c
trunk/owl/owl.h
trunk/owl/perlconfig.c
trunk/owl/perlglue.xs
trunk/owl/perlwrap.pm
Log:
Adding the ability to install real commands from perl.
Modified: trunk/owl/cmd.c
===================================================================
--- trunk/owl/cmd.c 2006-10-25 22:59:35 UTC (rev 404)
+++ trunk/owl/cmd.c 2006-10-26 15:14:41 UTC (rev 405)
@@ -56,6 +56,16 @@
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);
+}
+
char *owl_cmddict_execute(owl_cmddict *cd, owl_context *ctx, char *cmdbuff) {
char **argv;
int argc;
@@ -117,6 +127,8 @@
if (cmd->summary) owl_free(cmd->summary);
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);
}
int owl_cmd_is_context_valid(owl_cmd *cmd, owl_context *ctx) {
@@ -186,6 +198,8 @@
cmd->cmd_ctxv_fn(owl_context_get_data(ctx));
} 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);
}
return NULL;
Modified: trunk/owl/owl.h
===================================================================
--- trunk/owl/owl.h 2006-10-25 22:59:35 UTC (rev 404)
+++ trunk/owl/owl.h 2006-10-26 15:14:41 UTC (rev 405)
@@ -40,13 +40,6 @@
#ifndef INC_OWL_H
#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>
#include <netdb.h>
@@ -63,6 +56,16 @@
#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
+
static const char owl_h_fileIdent[] = "$Id$";
#define OWL_VERSION 2.1.11
@@ -304,6 +307,7 @@
* caller must free return value if !NULL */
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;
Modified: trunk/owl/perlconfig.c
===================================================================
--- trunk/owl/perlconfig.c 2006-10-25 22:59:35 UTC (rev 404)
+++ trunk/owl/perlconfig.c 2006-10-26 15:14:41 UTC (rev 405)
@@ -6,8 +6,6 @@
#include <errno.h>
#define OWL_PERL
#include "owl.h"
-#include <perl.h>
-#include "XSUB.h"
static const char fileIdent[] = "$Id$";
@@ -15,7 +13,7 @@
extern XS(boot_owl);
extern XS(boot_DynaLoader);
-extern XS(boot_DBI);
+// extern XS(boot_DBI);
static void owl_perl_xs_init(pTHX)
{
@@ -336,3 +334,46 @@
return(NULL);
}
}
+
+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);
+}
Modified: trunk/owl/perlglue.xs
===================================================================
--- trunk/owl/perlglue.xs 2006-10-25 22:59:35 UTC (rev 404)
+++ trunk/owl/perlglue.xs 2006-10-26 15:14:41 UTC (rev 405)
@@ -4,8 +4,6 @@
#include <zephyr/zephyr.h>
#endif
#include <EXTERN.h>
-#include <perl.h>
-#include <XSUB.h>
#define OWL_PERL
#include "owl.h"
@@ -74,3 +72,30 @@
CLEANUP:
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);
Modified: trunk/owl/perlwrap.pm
===================================================================
--- trunk/owl/perlwrap.pm 2006-10-25 22:59:35 UTC (rev 404)
+++ trunk/owl/perlwrap.pm 2006-10-26 15:14:41 UTC (rev 405)
@@ -31,6 +31,31 @@
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});
+}
+
#####################################################################
#####################################################################
