Author: dylan
Date: 2004-05-27 17:13:31 -0400 (Thu, 27 May 2004)
New Revision: 173
Modified:
trunk/haver-client/lib/Haver/Client/Commands.pm
Log:
Commit, dammit.
Modified: trunk/haver-client/lib/Haver/Client/Commands.pm
===================================================================
--- trunk/haver-client/lib/Haver/Client/Commands.pm 2004-05-27 21:02:32 UTC
(rev 172)
+++ trunk/haver-client/lib/Haver/Client/Commands.pm 2004-05-27 21:13:31 UTC
(rev 173)
@@ -29,61 +29,160 @@
sub initialize {
my ($me) = @_;
- $me->{chars} ||= '/.';
- $me->{default_cmd} ||= 'say';
+ $me->{chars} ||= '/.';
+ $me->{alias_sep} ||= ';';
+ $me->{expando_char} ||= '$';
+ $me->{say_cmd} ||= 'say';
+ $me->{alias} ||= {};
+ $me->{vars} ||= {};
}
+sub define {
+ my ($me, $var, $val) = @_;
-sub invoke {
+ $me->{vars}{$var} = $val;
+}
+
+sub undefine {
+ my ($me, $var) = @_;
+
+ delete $me->{vars}{$var};
+}
+
+sub is_defined {
+ my ($me, $var) = @_;
+
+ exists $me->{vars}{$var};
+}
+
+sub alias {
+ my ($me, $alias, $text) = @_;
+ $me->{alias}{$alias} = $text;
+}
+
+sub unalias {
+ my ($me, $alias) = @_;
+ delete $me->{alias}{$alias};
+}
+
+sub is_alias {
+ my ($me, $alias) = @_;
+
+ exists $me->{alias}{$alias};
+}
+
+sub eval_alias {
+ my ($me, $cmd, $arg) = @_;
+ my $c = quotemeta $me->{expando_char};
+ my $sep = quotemeta $me->{alias_sep};
+ my $text = $me->{alias}{$cmd};
+ 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(\S+)/$me->expando($1, [EMAIL PROTECTED],
$arg)/ge;
+ } else {
+ $s .= ' ' . $arg;
+ }
+ push(@lines, $s);
+ }
+
+ return @lines;
+}
+
+sub expando {
+ my ($me, $var, $args, $argstr) = @_;
+
+ if ($var =~ /^\d+$/) {
+ return $args->[$var];
+ } elsif ($var eq '*') {
+ return $argstr;
+ } elsif ($me->is_defined($var)) {
+ return $me->{vars}{$var};
+ } elsif (exists $ENV{$var}) {
+ return $ENV{$var};
+ } elsif ($var eq $me->{expando_char}) {
+ return $var;
+ }
+}
+
+sub input {
my ($me, $s) = @_;
- my ($cmd, @args) = $me->parse($s);
- my $method = "do_$cmd";
- my $obj = $me->{invoke} || $me;
-
- if ($obj->can($method)) {
- $obj->$method(@args);
+ my ($cmd, $arg) = $me->parse($s);
+
+ if ($me->is_alias($cmd)) {
+ my @lines = $me->eval_alias($cmd, $arg);
+
+ foreach my $line (@lines) {
+ $me->input($line);
+ }
} else {
- $obj->default_do($cmd, @args);
+ my @args = $me->parse_args($cmd, $arg);
+ $me->invoke($cmd, @args);
}
}
+sub invoke {
+ my ($me, $cmd, @args) = @_;
+
+ die "You must implement an invoke() method!";
+}
+
sub parse {
my ($me, $s) = @_;
my $c = quotemeta $me->{chars};
my ($cmd, $arg);
- if ($s =~ /^[$c] (\w+) (?:\s*) (.+) $/x) {
+ if ($s =~ /^[$c] (\w+) (?:\s*) (.*) $/x) {
$cmd = $1;
$arg = $2;
} else {
- $cmd = $me->{default_cmd};
+ $cmd = $me->{say_cmd};
$arg = $s;
}
-
- if (my $code = $me->can("parse_$cmd")) {
- return $code->($me, $cmd, $arg);
+
+ return ($cmd, $arg);
+}
+
+sub parse_args {
+ my ($me, $cmd, $arg) = @_;
+
+ if (my $code = $me->can("args_$cmd")) {
+ return $code->($me, $arg);
} else {
- return $me->default_parse($cmd, $arg);
+ return $me->default_args($cmd, $arg);
}
+
}
-sub default_do {
- my ($me, $cmd, @args) = @_;
- die "You should at least overload the default_do method!";
-}
-sub default_parse {
+sub default_args {
my ($me, $cmd, $arg) = @_;
- return ($cmd, $arg);
+ return ($arg);
}
-sub parse_raw {
- my ($me, $cmd, $arg) = @_;
+sub args_msg {
+ my ($me, $arg) = @_;
+ my ($targ) = $arg =~ s/^\s*(\S+)\s+//;
+
+ return ($targ, $arg);
+}
+
+sub args_raw {
+ my ($me, $arg) = @_;
my @args = grep(defined, Text::ParseWords::parse_line(qr/\s+/, 0,
$arg));
- return ($cmd, @args);
+ return (@args);
}
+sub args_alias {
+ my ($me, $arg) = @_;
+ $arg =~ s/^\s*(\w+)\s+//;
+
+ return ($1, $arg);
+}
-
1;
