Author: dylan
Date: 2004-05-28 00:30:01 -0400 (Fri, 28 May 2004)
New Revision: 177
Added:
trunk/haver-client/lib/Haver/Client/Command.pm
Removed:
trunk/haver-client/lib/Haver/Client/Commands.pm
Log:
Renamed to Command.
Copied: trunk/haver-client/lib/Haver/Client/Command.pm (from rev 176,
trunk/haver-client/lib/Haver/Client/Commands.pm)
===================================================================
--- trunk/haver-client/lib/Haver/Client/Commands.pm 2004-05-28 04:29:29 UTC
(rev 176)
+++ trunk/haver-client/lib/Haver/Client/Command.pm 2004-05-28 04:30:01 UTC
(rev 177)
@@ -0,0 +1,245 @@
+# Haver::Client::Command -- deal with /commands.
+#
+# 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;
+use strict;
+use warnings;
+
+use Text::ParseWords (); # we use parse_line.
+
+use Haver::Base;
+use base 'Haver::Base';
+
+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} ||= {};
+}
+
+
+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 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);
+
+ if ($s =~ /^[$c] (\w+) (?:\s*) (.*) $/x) {
+ $cmd = $1;
+ $arg = $2;
+ } else {
+ $cmd = $me->{say_cmd};
+ $arg = $s;
+ }
+
+ 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_args($cmd, $arg);
+ }
+
+}
+
+# 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;
+}
+
+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->get_var($1, [EMAIL
PROTECTED], $arg)/ge;
+ } else {
+ $s .= ' ' . $arg;
+ }
+ push(@lines, $s);
+ }
+
+ return @lines;
+}
+
+
+sub get_var {
+ my ($me, $var, $args, $argstr) = @_;
+
+ if ($var =~ /^\d+$/) {
+ return $args->[$var];
+ } elsif ($var eq '*') {
+ return $argstr;
+ } elsif ($me->is_defined($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}) {
+ return $var;
+ }
+}
+
+### Method stubs for defining commands
+sub commands {
+ my ($me) = @_;
+ my @cmds = keys %{ $me->{command} };
+ return wantarray ? @cmds : [EMAIL PROTECTED];
+}
+
+sub register {
+ my ($me, $cmd) = @_;
+ $me->{command}{$cmd} = 1;
+}
+
+sub unregister {
+ my ($me, $cmd) = @_;
+ delete $me->{command}{$cmd};
+}
+
+sub is_registered {
+ my ($me, $cmd) = @_;
+ exists $me->{command}{$cmd};
+}
+
+
+### 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;
+
Deleted: trunk/haver-client/lib/Haver/Client/Commands.pm
===================================================================
--- trunk/haver-client/lib/Haver/Client/Commands.pm 2004-05-28 04:29:29 UTC
(rev 176)
+++ trunk/haver-client/lib/Haver/Client/Commands.pm 2004-05-28 04:30:01 UTC
(rev 177)
@@ -1,245 +0,0 @@
-# Haver::Client::Commands -- deal with /commands.
-#
-# 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::Commands;
-use strict;
-use warnings;
-
-use Text::ParseWords (); # we use parse_line.
-
-use Haver::Base;
-use base 'Haver::Base';
-
-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} ||= {};
-}
-
-
-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 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);
-
- if ($s =~ /^[$c] (\w+) (?:\s*) (.*) $/x) {
- $cmd = $1;
- $arg = $2;
- } else {
- $cmd = $me->{say_cmd};
- $arg = $s;
- }
-
- 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_args($cmd, $arg);
- }
-
-}
-
-# 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;
-}
-
-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->get_var($1, [EMAIL
PROTECTED], $arg)/ge;
- } else {
- $s .= ' ' . $arg;
- }
- push(@lines, $s);
- }
-
- return @lines;
-}
-
-
-sub get_var {
- my ($me, $var, $args, $argstr) = @_;
-
- if ($var =~ /^\d+$/) {
- return $args->[$var];
- } elsif ($var eq '*') {
- return $argstr;
- } elsif ($me->is_defined($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}) {
- return $var;
- }
-}
-
-### Method stubs for defining commands
-sub commands {
- my ($me) = @_;
- my @cmds = keys %{ $me->{command} };
- return wantarray ? @cmds : [EMAIL PROTECTED];
-}
-
-sub register {
- my ($me, $cmd) = @_;
- $me->{command}{$cmd} = 1;
-}
-
-sub unregister {
- my ($me, $cmd) = @_;
- delete $me->{command}{$cmd};
-}
-
-sub is_registered {
- my ($me, $cmd) = @_;
- exists $me->{command}{$cmd};
-}
-
-
-### 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;
-
