Skip to content

Commit

Permalink
parsing code goes stand-alone
Browse files Browse the repository at this point in the history
  • Loading branch information
@garu
garu committed Dec 28, 2009
1 parent 858870c commit a358b44
Show file tree
Hide file tree
Showing 2 changed files with 172 additions and 166 deletions.
168 changes: 2 additions & 166 deletions lib/App/Rad.pm
View file
@@ -1,5 +1,6 @@
package App::Rad;
use 5.006;
use App::Rad::Parser;
use App::Rad::Command;
use App::Rad::Help;
use Carp ();
Expand Down Expand Up @@ -149,171 +150,6 @@ sub _register_functions {
}
}
# retrieves command line arguments
# to be executed by the main program
#
#When the parser starts, it fetches tokens left to right, validating them agains Global options. At the first argument not specified by a previous Global option, or at the first token that doesn't start with a hyphen (i.e. the first non-option given), the parser will determine which command it is. If the token is not a valid command, the invalid command is called. If there is no token at all, then the default command is called instead.
#TODO: handle ARGV
sub parse_input {
my $c = shift;
my @input = @_ || @ARGV; #TODO: keep doing this?
my $slurp = 0;
my $invalid;
print STDERR ">>> starting parser\n";
# we start with the global command
#my $current_command = $c->{'_globals'};
my $current_command = $c->{'_commands'}->{''};
my ($option_name, $option_value, $arguments_left);
while (my $token = shift @input) {
print STDERR ">>> token is '$token'\n";
# '--' marks the end of options
if ($token eq '--') {
print STDERR ">>> slurping...\n";
$slurp = 1;
}
# option found
elsif ( $token =~ s/^-// ) {
print STDERR ">>> option found\n";
Carp::croak "Missing $arguments_left argument(s) for option $option_name"
if $arguments_left;
# -foo=bar, --foo, --foo=bar
#if ( $token =~ m/^-?([^=]+)(?:=(.+))?/o ) {
#TODO: regex improvement?
#if ( $token =~ m/^(?:-([^=]+)(?:=(.+))?)|([^-=])+=(.+)$/o ) {
if ( $token =~ m/^(?:-([^=]+)(?:=(.+))?|([^-=]+)=(.+))$/o ) {
($option_name, $option_value) = (defined $4 ? ($3, $4) : ($1, $2));
print STDERR ">>> -foo=bar, --foo, --foo=bar\n";
}
# -foo
else {
print STDERR ">>> -foo\n";
my @flags = split //, $token;
# -f -o -o (if all elements are valid options, we push them back)
if (@flags > 1
&& @flags == (grep { $current_command->is_option($_) } @flags) ) {
print STDERR ">>> '@flags' are valid options, pushing them back\n";
unshift @input, map { '-' . $_ } @flags;
next;
}
# otherwise, -foo means the "foo" option
else {
print STDERR ">>> '$token' means the '$token' option\n";
($option_name, $option_value) = ($token, undef);
}
}
print STDERR ">>> setting option '$option_name' with value '$option_value'\n";
$arguments_left = $current_command->setopt($option_name, $option_value);
print STDERR ">>> returned $arguments_left as the number of arguments left for that option\n";
}
# when in slurp mode, tokens are arguments
elsif ($slurp or $arguments_left) {
print STDERR ">>> we are in slurp mode, or there are arguments left\n";
if (defined $option_name) {
print STDERR ">>> pushing yet another argument to option '$option_name' (value: '$token')\n";
$arguments_left = $current_command->setopt($option_name, $token);
print STDERR ">>> number of arguments left for option '$option_name': $arguments_left\n";
}
else {
print STDERR ">>> pushing token '$token' to c->argv queue\n";
push @{$c->argv}, $token;
}
}
# we already have a command, so it's a stand-alone argument
# TODO: should we allow it in all cases?
# TODO: parsing chained commands
elsif ( defined $c->cmd or defined $invalid) {
print STDERR ">>> we already have a command, push token '$token' to c->argv queue\n";
push @{$c->argv}, $token;
}
# it's a command, and no previous command was set
elsif ( $c->is_command($token) ) {
$current_command = $c->{'_commands'}->{$token};
$c->cmd = $current_command->name;
print STDERR ">>> got command: '" . $c->cmd . "'\n";
}
# it's an invalid command
else {
print STDERR ">>> TODO: invalid command\n";
$invalid = $token; #TODO: pass it as something else, maybe?
# return;
# set as invalid and mark $c->cmd, but keep parsing the invalid
# command as '' (global)
#$invalid = 1;
}
}
Carp::croak "missing $arguments_left argument(s) for option '$option_name'"
if $arguments_left;
# TODO: this should be done whenever a command is 'done',
# not when the input is over
check_required($current_command); # TODO: this goes into Parser.pm
check_conflicts($current_command); # TODO: this goes into Parser.pm
set_defaults($current_command); # TODO: this goes into Parser.pm
push_to_stash($c, $current_command); # TODO: this goes into Parser.pm
# let caller know if command was set or if we'll use the default
$c->cmd = '' unless defined $c->cmd;
return $invalid;
}
sub check_required {
my $command = shift;
foreach my $option (keys %{ $command->{opts} }) {
if ( $command->{opts}->{$option}->{required}
and not exists $command->options->{$option}
) {
require Carp;
Carp::croak "option '$option' is required for command " . $command->name;
}
}
}
sub check_conflicts {
my $command = shift;
foreach my $option (sort keys %{ $command->{options} }) {
my $conflicts = $command->{opts}->{$option}->{conflicts_with};
if ( $conflicts ) {
# TODO make sure we store it as a ref, so we don't have to do the below
$conflicts = [ $conflicts ] unless ref $conflicts;
foreach my $conflict ( @{$conflicts} ) {
if (defined $command->{options}->{$conflict}) {
require Carp;
Carp::croak "options '$option' and '$conflict' conflict and can not be used together";
}
}
}
}
}
sub set_defaults {
my $command = shift;
foreach my $option (keys %{ $command->{opts} }) {
if ( $command->{opts}->{$option}->{default}
and not exists $command->options->{$option}
) {
$command->options->{$option} = $command->{opts}->{$option}->{default};
}
}
}
sub push_to_stash {
my ($c, $command) = (@_);
foreach my $option (keys %{ $command->{opts} }) {
if ( $command->options->{$option} and (my $stash = $command->{opts}->{$option}->{to_stash} )) {
$stash = [ $stash ] unless ref $stash; # TODO: always store to_stash under an array ref
foreach my $elem ( @{$stash} ) {
$c->stash->{$elem} = $command->options->{$option};
}
}
}
}
sub _run_full_round {
my $c = shift;
my $cmd = shift;
Expand Down Expand Up @@ -547,7 +383,7 @@ sub run {
# now we get the actual input from
# the command line (someone using the app!)
my $arg = $c->parse_input();
my $arg = App::Rad::Parser::parse_input($c);
my $cmd_obj = $c->{'_commands'}->{$c->cmd};
# handle special cases (default and invalid)
Expand Down
170 changes: 170 additions & 0 deletions lib/App/Rad/Parser.pm
View file
@@ -1,3 +1,173 @@
package App::Rad::Parser;
use Carp ();
use strict;
use warnings;

# retrieves command line arguments
# to be executed by the main program
#
#When the parser starts, it fetches tokens left to right, validating them agains Global options. At the first argument not specified by a previous Global option, or at the first token that doesn't start with a hyphen (i.e. the first non-option given), the parser will determine which command it is. If the token is not a valid command, the invalid command is called. If there is no token at all, then the default command is called instead.
#TODO: handle ARGV
sub parse_input {
my $c = shift;
my @input = @_ || @ARGV; #TODO: keep doing this?
my $slurp = 0;
my $invalid;

print STDERR ">>> starting parser\n";
# we start with the global command
#my $current_command = $c->{'_globals'};
my $current_command = $c->{'_commands'}->{''};
my ($option_name, $option_value, $arguments_left);

while (my $token = shift @input) {
print STDERR ">>> token is '$token'\n";
# '--' marks the end of options
if ($token eq '--') {
print STDERR ">>> slurping...\n";
$slurp = 1;
}
# option found
elsif ( $token =~ s/^-// ) {
print STDERR ">>> option found\n";
Carp::croak "Missing $arguments_left argument(s) for option $option_name"
if $arguments_left;

# -foo=bar, --foo, --foo=bar
#if ( $token =~ m/^-?([^=]+)(?:=(.+))?/o ) {
#TODO: regex improvement?
#if ( $token =~ m/^(?:-([^=]+)(?:=(.+))?)|([^-=])+=(.+)$/o ) {
if ( $token =~ m/^(?:-([^=]+)(?:=(.+))?|([^-=]+)=(.+))$/o ) {
($option_name, $option_value) = (defined $4 ? ($3, $4) : ($1, $2));
print STDERR ">>> -foo=bar, --foo, --foo=bar\n";
}
# -foo
else {
print STDERR ">>> -foo\n";
my @flags = split //, $token;
# -f -o -o (if all elements are valid options, we push them back)
if (@flags > 1
&& @flags == (grep { $current_command->is_option($_) } @flags) ) {
print STDERR ">>> '@flags' are valid options, pushing them back\n";
unshift @input, map { '-' . $_ } @flags;
next;
}
# otherwise, -foo means the "foo" option
else {
print STDERR ">>> '$token' means the '$token' option\n";
($option_name, $option_value) = ($token, undef);
}
}
print STDERR ">>> setting option '$option_name' with value '$option_value'\n";
$arguments_left = $current_command->setopt($option_name, $option_value);
print STDERR ">>> returned $arguments_left as the number of arguments left for that option\n";
}
# when in slurp mode, tokens are arguments
elsif ($slurp or $arguments_left) {
print STDERR ">>> we are in slurp mode, or there are arguments left\n";
if (defined $option_name) {
print STDERR ">>> pushing yet another argument to option '$option_name' (value: '$token')\n";
$arguments_left = $current_command->setopt($option_name, $token);
print STDERR ">>> number of arguments left for option '$option_name': $arguments_left\n";
}
else {
print STDERR ">>> pushing token '$token' to c->argv queue\n";
push @{$c->argv}, $token;
}
}
# we already have a command, so it's a stand-alone argument
# TODO: should we allow it in all cases?
# TODO: parsing chained commands
elsif ( defined $c->cmd or defined $invalid) {
print STDERR ">>> we already have a command, push token '$token' to c->argv queue\n";
push @{$c->argv}, $token;
}
# it's a command, and no previous command was set
elsif ( $c->is_command($token) ) {
$current_command = $c->{'_commands'}->{$token};
$c->cmd = $current_command->name;
print STDERR ">>> got command: '" . $c->cmd . "'\n";
}
# it's an invalid command
else {
print STDERR ">>> TODO: invalid command\n";
$invalid = $token; #TODO: pass it as something else, maybe?
# return;
# set as invalid and mark $c->cmd, but keep parsing the invalid
# command as '' (global)
#$invalid = 1;
}
}
Carp::croak "missing $arguments_left argument(s) for option '$option_name'"
if $arguments_left;

# TODO: this should be done whenever a command is 'done',
# not when the input is over
check_required($current_command); # TODO: this goes into Parser.pm
check_conflicts($current_command); # TODO: this goes into Parser.pm
set_defaults($current_command); # TODO: this goes into Parser.pm
push_to_stash($c, $current_command); # TODO: this goes into Parser.pm

# let caller know if command was set or if we'll use the default
$c->cmd = '' unless defined $c->cmd;
return $invalid;
}

sub check_required {
my $command = shift;
foreach my $option (keys %{ $command->{opts} }) {
if ( $command->{opts}->{$option}->{required}
and not exists $command->options->{$option}
) {
Carp::croak "option '$option' is required for command " . $command->name;
}
}
}

sub check_conflicts {
my $command = shift;
foreach my $option (sort keys %{ $command->{options} }) {
my $conflicts = $command->{opts}->{$option}->{conflicts_with};
if ( $conflicts ) {
# TODO make sure we store it as a ref, so we don't have to do the below
$conflicts = [ $conflicts ] unless ref $conflicts;

foreach my $conflict ( @{$conflicts} ) {
if (defined $command->{options}->{$conflict}) {
Carp::croak "options '$option' and '$conflict' conflict and can not be used together";
}
}
}
}
}

sub set_defaults {
my $command = shift;
foreach my $option (keys %{ $command->{opts} }) {
if ( $command->{opts}->{$option}->{default}
and not exists $command->options->{$option}
) {
$command->options->{$option} = $command->{opts}->{$option}->{default};
}
}
}

sub push_to_stash {
my ($c, $command) = (@_);
foreach my $option (keys %{ $command->{opts} }) {
if ( $command->options->{$option} and (my $stash = $command->{opts}->{$option}->{to_stash} )) {
$stash = [ $stash ] unless ref $stash; # TODO: always store to_stash under an array ref

foreach my $elem ( @{$stash} ) {
$c->stash->{$elem} = $command->options->{$option};
}
}
}
}


42;
__END__
=head1 WARNING: INTERNAL SPEC DOCUMENT AHEAD!
This attempts to be a thorough explanation of the command line parsing done by L<< App::Rad >> in the purpose of explicit clarification, internal documentation and troubleshooting. If you are looking for how to create command line apps, please look into L<< App::Rad >>'s main documentation instead.
Expand Down

0 comments on commit a358b44

Please sign in to comment.