Author: dylan
Date: 2004-06-28 02:01:04 -0400 (Mon, 28 Jun 2004)
New Revision: 273
Modified:
trunk/main/client/lib/Haver/Client/Command.pm
Log:
Skeleton command parser, dispatcher.
Upon this we will build the kind of command thingy bdonlan wants.
Modified: trunk/main/client/lib/Haver/Client/Command.pm
===================================================================
--- trunk/main/client/lib/Haver/Client/Command.pm 2004-06-28 06:00:29 UTC
(rev 272)
+++ trunk/main/client/lib/Haver/Client/Command.pm 2004-06-28 06:01:04 UTC
(rev 273)
@@ -22,26 +22,17 @@
use Carp qw(croak confess carp);
use Haver::Preprocessor;
-use Text::ParseWords (); # we use parse_line.
-
use Haver::Base;
use base 'Haver::Base';
+use Haver::Callback;
-use Scalar::Util ();
+our $VERSION = 0.03;
-our $VERSION = '0.01';
-
sub initialize {
my ($me) = @_;
$me->{chars} ||= '/.';
- $me->{alias_sep} ||= ';';
- $me->{expando_char} ||= '$';
- $me->{say_cmd} ||= 'say';
- $me->{builtin_cmd} ||= 'builtin';
- $me->{alias} ||= {};
- $me->{vars} ||= {};
- $me->{command} ||= {};
+ $me->{no_cmd} ||= 'say';
}
@@ -54,23 +45,18 @@
$cmd = $1;
$arg = $2;
} else {
- $cmd = $me->{say_cmd};
+ $cmd = $me->{no_cmd};
$arg = $s;
}
return ($cmd, $arg);
}
-sub invoke {
- my ($me, $cmd, $arg) = @_;
-
-}
-
-sub resolve_command {
+sub resolve {
my ($me, $prefix) = @_;
my $len = length $prefix;
my %seen;
- my @cmds = grep { not $seen{$_}++ } $me->commands, $me->aliases;
+ my @cmds = grep { not $seen{$_}++ } $me->commands;
my @found;
return $prefix if exists $seen{$prefix};
@@ -90,91 +76,23 @@
}
}
-### Methods for manipulating aliases.
-sub aliases {
- my ($me) = @_;
- my @a = keys %{ $me->{alias} };
-
- return wantarray ? @a : [EMAIL PROTECTED];
-}
+sub invoke {
+ my ($me, $cmd, $arg) = @_;
-sub alias {
- my ($me, $alias, $text) = @_;
- $me->{alias}{$alias} = $text;
+ $me->{command}{$cmd}->call($arg);
}
-sub unalias {
- my ($me, $alias) = @_;
- delete $me->{alias}{$alias};
-}
-
-sub is_alias {
- my ($me, $alias) = @_;
-
- exists $me->{alias}{$alias};
-}
-
-sub eval_text {
- my ($me, $text, $arg) = @_;
- my $c = quotemeta $me->{expando_char};
- my $sep = quotemeta $me->{alias_sep};
- my @cmds = grep(defined, Text::ParseWords::parse_line(qr/\s*$sep\s*/,
1, $text));
- my @lines;
-
-
- foreach my $s (@cmds) {
- if ($text =~ /$c([0-9]|\*)/) {
- my @args = Text::ParseWords::parse_line(qr/\s+/, 0,
$arg);
- $s =~ s/$c([\w\*:$c-]+)/$me->expand($1, [EMAIL
PROTECTED], $arg)/ge;
- } else {
- $s .= ' ' . $arg;
- }
- push(@lines, $s);
+sub input {
+ my ($me, $s) = @_;
+ my ($cmd, $arg) = $me->parse($s);
+ ($cmd) = $me->resolve($cmd);
+ die "invalid command!" unless defined $cmd;
+ if (ref $cmd) {
+ $cmd = $cmd->[0];
}
-
- return @lines;
+ $me->invoke($cmd, $arg);
}
-
-sub expand {
- my ($me, $var, $args, $argstr) = @_;
-
- if ($var =~ /^-?\d+$/) {
- return $args->[$var];
- } elsif ($var =~ /^(\d+)-(\d+)$/) {
- return join(' ', @$args[$1 .. $2]);
- } elsif ($var =~ /^(\d+)-$/) {
- return join(' ', @$args[$1 .. $#$args]);
- } elsif ($var eq '*') {
- return $argstr || join(' ', @$args);
- } elsif ($me->is_defined($var)) {
- return $me->_value($var, $me->{vars}{$var});
- } elsif (exists $ENV{$var}) {
- return $ENV{$var};
- } elsif ($var eq $me->{expando_char}) {
- return $var;
- } else {
- return undef;
- }
-}
-
-sub _value {
- my ($me, $var, $val) = @_;
-
- if (ref $val) {
- if (ref($val) eq 'CODE') {
- $me->_value($var, $val->($me, $var));
- } elsif (ref ($val) eq 'ARRAY') {
- return join(' ', @$val);
- } else {
- return $val;
- }
- } else {
- return $val;
- }
-}
-
-### Method stubs for defining commands
sub commands {
my ($me) = @_;
my @cmds = keys %{ $me->{command} };
@@ -182,8 +100,8 @@
}
sub register {
- my ($me, $cmd, %opt) = @_;
- $me->{command}{$cmd} = \%opt;
+ my ($me, $cmd, $cb) = @_;
+ $me->{command}{$cmd} = new Haver::Callback($cb);
}
sub unregister {
@@ -197,26 +115,5 @@
}
-### Methods for defining $vars used in aliases.
-sub define {
- my ($me, $var, $val) = @_;
- $me->{vars}{$var} = $val;
-}
-
-sub undefine {
- my ($me, $var) = @_;
-
- delete $me->{vars}{$var};
-}
-
-sub is_defined {
- my ($me, $var) = @_;
-
- exists $me->{vars}{$var};
-}
-
-
-
1;
-
