diff --git a/lib/App/Rad.pm b/lib/App/Rad.pm index 7cb2bd7..f0a14cb 100644 --- a/lib/App/Rad.pm +++ b/lib/App/Rad.pm @@ -1,5 +1,6 @@ package App::Rad; use 5.006; +use App::Rad::Parser; use App::Rad::Command; use App::Rad::Help; use Carp (); @@ -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; @@ -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) diff --git a/lib/App/Rad/Parser.pm b/lib/App/Rad/Parser.pm index d2a6bf6..0ee3f1d 100644 --- a/lib/App/Rad/Parser.pm +++ b/lib/App/Rad/Parser.pm @@ -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.