As part of a larger program I'm working on, I developed a simple
regex-based command parser. The commands available are defined
in a hash called %COMMANDS, which has the following structure:
'command' => [
['summary1', 'description1',
'regex for args of summary1', 'cmdnametocall1']
['summary2' , 'description2',
'regex for args of summary2', 'cmdnametocall2']
...
]
In my program, there are commands that have the same name, but
that behave differently depending on the arguments they are
given. The 'summary' is a short description of the syntax,
and the 'description' is what gets printed in the help message.
If the corresponding 'cmdnametocall' is given, subroutine
command_cmdnametocall is called, otherwise, subroutine
command_command is called. Each regex group
(defined by parenthesis) found in the regular expression
for the command arguments is passed to the subroutine as
an argument. In the code below, three sample commands are
defined: help (no arguments), "delete NAME from LIST" (two
arguments: NAME and LIST) and "delete LIST,..." (one argument: the
list of lists to delete).
Note that for the first form of the delete command, the
subroutine
command_delete is called, and for the
second,
command_deletelist is called.
To use this, call execute_command with the command line to
execute as argument. If it returns undef, everything went
ok, otherwise it returns an error message.
There are many little frills and details
that I have omitted for the sake of space, but it should work
properly.
%COMMANDS=(
'help' => [['help or ?', 'Print this command summary.', '']],
'delete' => [
['delete NAME from LIST',
'Delete the name from the mailing list.',
'(\S+)\s+from\s+(\S+)'],
['delete LIST,...',
'Delete mailing lists.',
'(.+)', 'deletelists'],
]
);
# Execute a command by calling the appropriate subroutine.
# The first argument contains the command to execute.
sub execute_command {
my $line=shift || return;
$line=~s/^\s*//; $line=~s/\s*$//;
my ($cmd, $args)=($line=~/^(\S+)(?:\s+(.*))?$/);
return unless $cmd;
$args||="";
$cmd=lc($cmd);
if (exists($COMMANDS{$cmd})) {
# The command is in our list of valid commands.
my @forms=@{$COMMANDS{$cmd}};
my $form;
my $summaries;
foreach $form (@forms) {
my $regex=$form->[2];
my $sum=$form->[0];
# This collects summaries for an error message if arg syntax is
+wrong
$summaries.="\t$sum\n";
my @args;
if (@args=($args=~/^$regex$/)) {
# Got a match
# Assign @args only if there were parenthesis in the pattern.
@args=undef unless defined($+);
# Now we are ready to execute the command.
# Determine the name of the subroutine to call
my $cmdcall=$form->[3] || $cmd;
# Call the subroutine
eval "command_$cmdcall".'(@args)';
if ($@) {
die "Internal error calling command_$cmdcall: $@\n";
}
# Returning undef means everything went ok.
return;
}
}
# If we get here, we didn't match any of the valid forms of the co
+mmand.
return("Invalid syntax, I expect one of:\n$summaries");
}
else {
return("Unknown command:\n\t$line\n");
}
}
# Sample command definitions
sub command_help {
print("The current commands are: ([]'s denote optional, caps need va
+lues)\n"
);
my $cmd;
my $form;
foreach $cmd (sort keys %COMMANDS) {
foreach $form (@{$COMMANDS{$cmd}}) {
my ($sum, $desc)=@$form;
print "$sum: $desc\n"
}
}
}
sub command_delete {
my ($name, $list)=@_
# Delete $name from $list
}
sub command_deletelists {
my $lists=shift;
my @lists=split(/[,\s]+/, $lists);
# Delete @lists
}
