Author: dylan
Date: 2004-05-28 00:29:29 -0400 (Fri, 28 May 2004)
New Revision: 176
Added:
trunk/haver-client/lib/Haver/Client/Command/
trunk/haver-client/lib/Haver/Client/Command/Callback.pm
Modified:
trunk/haver-client/lib/Haver/Client/Commands.pm
Log:
Added callback flavor.
Added: trunk/haver-client/lib/Haver/Client/Command/Callback.pm
===================================================================
--- trunk/haver-client/lib/Haver/Client/Command/Callback.pm 2004-05-27
21:57:10 UTC (rev 175)
+++ trunk/haver-client/lib/Haver/Client/Command/Callback.pm 2004-05-28
04:29:29 UTC (rev 176)
@@ -0,0 +1,56 @@
+# Haver::Client::Command::Callback - register commands as callbacks.
+#
+# Copyright (C) 2004 Bryan Donlan, Dylan William Hardison.
+#
+# This module is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# This module is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this module; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+package Haver::Client::Command::Callback;
+use strict;
+use warnings;
+
+use Text::ParseWords (); # we use parse_line.
+
+use Haver::Base;
+use base 'Haver::Client::Command';
+
+our $VERSION = 0.01;
+
+sub register {
+ my ($me, $cmd, %opt) = @_;
+ $me->{command}{$cmd} = \%opt;
+}
+
+sub invoke {
+ my ($me, $cmd, @args) = @_;
+
+ if (exists $me->{command}{$cmd} and exists
$me->{command}{$cmd}{handler}) {
+ $me->{command}{$cmd}{handler}->($me, $cmd, @args);
+ } else {
+ $me->error('unknown command');
+ }
+}
+
+sub parse_args {
+ my ($me, $cmd, $arg) = @_;
+
+ if (exists $me->{command}{$cmd} and exists
$me->{command}{$cmd}{parser}) {
+ return $me->{command}{$cmd}{parser}->($me, $cmd, $arg);
+ } else {
+ return ($arg);
+ }
+}
+
+
+
+1;
Modified: trunk/haver-client/lib/Haver/Client/Commands.pm
===================================================================
--- trunk/haver-client/lib/Haver/Client/Commands.pm 2004-05-27 21:57:10 UTC
(rev 175)
+++ trunk/haver-client/lib/Haver/Client/Commands.pm 2004-05-28 04:29:29 UTC
(rev 176)
@@ -33,28 +33,109 @@
$me->{alias_sep} ||= ';';
$me->{expando_char} ||= '$';
$me->{say_cmd} ||= 'say';
+ $me->{builtin_cmd} ||= 'builtin';
$me->{alias} ||= {};
$me->{vars} ||= {};
+ $me->{command} ||= {};
}
-sub define {
- my ($me, $var, $val) = @_;
- $me->{vars}{$var} = $val;
+sub input {
+ my ($me, $s) = @_;
+ my ($cmd, $arg) = $me->parse($s);
+
+ if ($me->is_alias($cmd) and $cmd ne $me->{builtin_cmd}) {
+ my @lines = $me->eval_text($me->{alias}{$cmd}, $arg);
+
+ foreach my $line (@lines) {
+ $me->input($line);
+ }
+ } else {
+ my @args;
+ if ($cmd eq $me->{builtin_cmd}) {
+ $arg =~ s/^\s*(\w+)\s+//;
+ $cmd = $1;
+ @args = $me->parse_args($cmd, $arg);
+ } else {
+ @args = $me->parse_args($cmd, $arg);
+ }
+ $me->invoke($cmd, @args);
+ }
}
-sub undefine {
- my ($me, $var) = @_;
+sub invoke {
+ my ($me, $cmd, @args) = @_;
+ use Data::Dumper;
+ print Dumper({$cmd, [EMAIL PROTECTED]);
+}
+
+sub parse {
+ my ($me, $s) = @_;
+ my $c = quotemeta $me->{chars};
+ my ($cmd, $arg);
- delete $me->{vars}{$var};
+ if ($s =~ /^[$c] (\w+) (?:\s*) (.*) $/x) {
+ $cmd = $1;
+ $arg = $2;
+ } else {
+ $cmd = $me->{say_cmd};
+ $arg = $s;
+ }
+
+ return ($cmd, $arg);
}
-sub is_defined {
- my ($me, $var) = @_;
+sub parse_args {
+ my ($me, $cmd, $arg) = @_;
+
+ if (my $code = $me->can("args_$cmd")) {
+ return $code->($me, $arg);
+ } else {
+ return $me->default_args($cmd, $arg);
+ }
- exists $me->{vars}{$var};
}
+# This is called when there is no args_$cmd function.
+sub default_args {
+ my ($me, $cmd, $arg) = @_;
+ return ($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 (@args);
+}
+
+sub args_alias {
+ my ($me, $arg) = @_;
+ $arg =~ s/^\s*(\w+)\s+//;
+
+ return ($1, $arg);
+}
+
+sub args_builtin {
+ my ($me, $arg) = @_;
+
+ return ($1, $arg);
+}
+
+### Methods for manipulating aliases.
+sub aliases {
+ my ($me) = @_;
+ my @a = keys %{ $me->{alias} };
+
+ return wantarray ? @a : [EMAIL PROTECTED];
+}
+
sub alias {
my ($me, $alias, $text) = @_;
$me->{alias}{$alias} = $text;
@@ -71,11 +152,10 @@
exists $me->{alias}{$alias};
}
-sub eval_alias {
- my ($me, $cmd, $arg) = @_;
+sub eval_text {
+ my ($me, $text, $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;
@@ -83,7 +163,7 @@
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;
+ $s =~ s/$c([\w\*$c]+)/$me->get_var($1, [EMAIL
PROTECTED], $arg)/ge;
} else {
$s .= ' ' . $arg;
}
@@ -93,7 +173,8 @@
return @lines;
}
-sub expando {
+
+sub get_var {
my ($me, $var, $args, $argstr) = @_;
if ($var =~ /^\d+$/) {
@@ -101,7 +182,14 @@
} elsif ($var eq '*') {
return $argstr;
} elsif ($me->is_defined($var)) {
- return $me->{vars}{$var};
+ my $val = $me->{vars}{$var};
+ if (not ref $val) {
+ return $val;
+ } elsif (ref($val) eq 'CODE') {
+ return $val->($me, $var);
+ } else {
+ return $val;
+ }
} elsif (exists $ENV{$var}) {
return $ENV{$var};
} elsif ($var eq $me->{expando_char}) {
@@ -109,80 +197,49 @@
}
}
-sub input {
- my ($me, $s) = @_;
- 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 {
- my @args = $me->parse_args($cmd, $arg);
- $me->invoke($cmd, @args);
- }
+### Method stubs for defining commands
+sub commands {
+ my ($me) = @_;
+ my @cmds = keys %{ $me->{command} };
+ return wantarray ? @cmds : [EMAIL PROTECTED];
}
-sub invoke {
- my ($me, $cmd, @args) = @_;
-
- die "You must implement an invoke() method!";
+sub register {
+ my ($me, $cmd) = @_;
+ $me->{command}{$cmd} = 1;
}
-sub parse {
- my ($me, $s) = @_;
- my $c = quotemeta $me->{chars};
- my ($cmd, $arg);
-
- if ($s =~ /^[$c] (\w+) (?:\s*) (.*) $/x) {
- $cmd = $1;
- $arg = $2;
- } else {
- $cmd = $me->{say_cmd};
- $arg = $s;
- }
-
- return ($cmd, $arg);
+sub unregister {
+ my ($me, $cmd) = @_;
+ delete $me->{command}{$cmd};
}
-sub parse_args {
- my ($me, $cmd, $arg) = @_;
-
- if (my $code = $me->can("args_$cmd")) {
- return $code->($me, $arg);
- } else {
- return $me->default_args($cmd, $arg);
- }
-
+sub is_registered {
+ my ($me, $cmd) = @_;
+ exists $me->{command}{$cmd};
}
-sub default_args {
- my ($me, $cmd, $arg) = @_;
- return ($arg);
-}
+### Methods for defining $vars used in aliases.
+sub define {
+ my ($me, $var, $val) = @_;
-sub args_msg {
- my ($me, $arg) = @_;
- my ($targ) = $arg =~ s/^\s*(\S+)\s+//;
-
- return ($targ, $arg);
+ $me->{vars}{$var} = $val;
}
-sub args_raw {
- my ($me, $arg) = @_;
- my @args = grep(defined, Text::ParseWords::parse_line(qr/\s+/, 0,
$arg));
- return (@args);
+sub undefine {
+ my ($me, $var) = @_;
+
+ delete $me->{vars}{$var};
}
-sub args_alias {
- my ($me, $arg) = @_;
- $arg =~ s/^\s*(\w+)\s+//;
+sub is_defined {
+ my ($me, $var) = @_;
- return ($1, $arg);
+ exists $me->{vars}{$var};
}
+
+
1;
