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 }