Changeset 6922edd


Ignore:
Timestamp:
Oct 26, 2006, 11:14:41 AM (17 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:
5 edited

Legend:

Unmodified
Added
Removed
  • cmd.c

    rf1e629d r6922edd  
    5555  owl_dict_insert_element(cd, cmd->name, (void*)cmd, (void(*)(void*))owl_cmd_free);   
    5656  return(0);
     57}
     58
     59int owl_cmddict_add_cmd(owl_cmddict *cd, owl_cmd * cmd) {
     60  owl_cmd * newcmd = owl_malloc(sizeof(owl_cmd));
     61  if(owl_cmd_create_from_template(newcmd, cmd) < 0) {
     62    owl_free(newcmd);
     63    return -1;
     64  }
     65  owl_function_debugmsg("Add cmd %s", cmd->name);
     66  return owl_dict_insert_element(cd, newcmd->name, (void*)newcmd, (void(*)(void*))owl_cmd_free);
    5767}
    5868
     
    118128  if (cmd->usage) owl_free(cmd->usage);
    119129  if (cmd->description) owl_free(cmd->description);
     130  if (cmd->cmd_aliased_to) owl_free(cmd->cmd_aliased_to);
     131  if (cmd->cmd_perl) owl_perlconfig_cmd_free(cmd);
    120132}
    121133
     
    187199  } else if (cmd->cmd_ctxi_fn) {
    188200    cmd->cmd_ctxi_fn(owl_context_get_data(ctx), ival);
     201  } else if (cmd->cmd_perl) {
     202    return owl_perlconfig_perlcmd(cmd, argc, argv);
    189203  }
    190204
  • owl.h

    r4211f50b r6922edd  
    4141#define INC_OWL_H
    4242
    43 /* Perl and curses don't play nice. */
    44 #ifndef OWL_PERL
    45 #include <curses.h>
    46 #else
    47 #define WINDOW void
    48 #endif
    49 
    5043#include <sys/param.h>
    5144#include <EXTERN.h>
     
    6255#ifdef HAVE_COM_ERR_H
    6356#include <com_err.h>
     57#endif
     58
     59/* Perl and curses don't play nice. */
     60#ifdef OWL_PERL
     61typedef void WINDOW;
     62#include <perl.h>
     63#include "XSUB.h"
     64#else
     65#include <curses.h>
     66typedef void SV;
    6467#endif
    6568
     
    305308  void (*cmd_ctxv_fn)(void *ctx);               /* takes no args */
    306309  void (*cmd_ctxi_fn)(void *ctx, int i);        /* takes an int as an arg */
     310  SV *cmd_perl;                                /* Perl closure that takes a list of args */
    307311} owl_cmd;
    308312
  • perlconfig.c

    r216c734 r6922edd  
    77#define OWL_PERL
    88#include "owl.h"
    9 #include <perl.h>
    10 #include "XSUB.h"
    119
    1210static const char fileIdent[] = "$Id$";
     
    1614extern XS(boot_owl);
    1715extern XS(boot_DynaLoader);
    18 extern XS(boot_DBI);
     16// extern XS(boot_DBI);
    1917
    2018static void owl_perl_xs_init(pTHX)
     
    337335  }
    338336}
     337
     338char *owl_perlconfig_perlcmd(owl_cmd *cmd, int argc, char **argv)
     339{
     340  int i, count;
     341  char * ret = NULL;
     342  STRLEN n_a;
     343  dSP;
     344
     345  ENTER;
     346  SAVETMPS;
     347
     348  PUSHMARK(SP);
     349  for(i=0;i<argc;i++) {
     350    XPUSHs(sv_2mortal(newSVpv(argv[i], 0)));
     351  }
     352  PUTBACK;
     353
     354  count = call_sv(cmd->cmd_perl, G_SCALAR|G_EVAL);
     355
     356  SPAGAIN;
     357
     358  if(SvTRUE(ERRSV)) {
     359    owl_function_error("Error: %s", SvPV(ERRSV, n_a));
     360    POPs;
     361  } else {
     362    if(count != 1)
     363      croak("Perl command %s returned more than one value!", cmd->name);
     364    SV * rv = POPs;
     365    if(SvTRUE(rv)) {
     366      ret = owl_strdup(SvPV(rv, n_a));
     367    }
     368  }
     369
     370  FREETMPS;
     371  LEAVE;
     372
     373  return ret;
     374}
     375
     376void owl_perlconfig_cmd_free(owl_cmd *cmd)
     377{
     378  SvREFCNT_dec(cmd);
     379}
  • perlglue.xs

    r1152d45 r6922edd  
    55#endif
    66#include <EXTERN.h>
    7 #include <perl.h>
    8 #include <XSUB.h>
    97
    108#define OWL_PERL
     
    7573                if (rv) owl_free(rv);
    7674
     75void
     76new_command_internal(name, func, summary, usage, description)
     77        char *name
     78        SV *func
     79        char *summary
     80        char *usage
     81        char *description
     82        PREINIT:
     83                owl_cmd cmd;
     84        CODE:
     85                SvREFCNT_inc(func);
     86                cmd.name = name;
     87                cmd.cmd_perl = func;
     88                cmd.summary = summary;
     89                cmd.usage = usage;
     90                cmd.description = description;
     91                cmd.validctx = OWL_CTX_ANY;
     92
     93                cmd.cmd_aliased_to = NULL;
     94                cmd.cmd_args_fn = NULL;
     95                cmd.cmd_v_fn = NULL;
     96                cmd.cmd_i_fn = NULL;
     97                cmd.cmd_ctxargs_fn = NULL;
     98                cmd.cmd_ctxv_fn = NULL;
     99                cmd.cmd_ctxi_fn = NULL;
     100
     101                owl_cmddict_add_cmd(owl_global_get_cmddict(&g), &cmd);
  • perlwrap.pm

    r216c734 r6922edd  
    3030    $called =~ s/.*:://;
    3131    return &owl::command("$called ".join(" ",@_));
     32}
     33
     34=head2 new_command NAME FUNC [{ARGS}]
     35
     36Add a new owl command. When owl executes the command NAME, FUNC will
     37be called with the arguments passed to the command, with NAME as the
     38first argument.
     39
     40ARGS should be a hashref containing any or all of C<summary>,
     41C<usage>, or C<description> keys.
     42
     43=cut
     44
     45sub new_command {
     46    my $name = shift;
     47    my $func = shift;
     48    my $args = shift || {};
     49    my %args = (
     50        summary     => undef,
     51        usage       => undef,
     52        description => undef,
     53        %{$args}
     54    );
     55
     56    owl::new_command_internal($name, $func, $args{summary}, $args{usage}, $args{description});
    3257}
    3358
Note: See TracChangeset for help on using the changeset viewer.