summaryrefslogtreecommitdiff
path: root/lib/Getopt/Dakkar/Role/Command.pm
diff options
context:
space:
mode:
Diffstat (limited to 'lib/Getopt/Dakkar/Role/Command.pm')
-rw-r--r--lib/Getopt/Dakkar/Role/Command.pm53
1 files changed, 40 insertions, 13 deletions
diff --git a/lib/Getopt/Dakkar/Role/Command.pm b/lib/Getopt/Dakkar/Role/Command.pm
index 444a9a4..2a3186b 100644
--- a/lib/Getopt/Dakkar/Role/Command.pm
+++ b/lib/Getopt/Dakkar/Role/Command.pm
@@ -1,5 +1,7 @@
package Getopt::Dakkar::Role::Command;
use Getopt::Dakkar::Style qw(role);
+use Getopt::Dakkar::ArgPack;
+use Module::Runtime qw(use_module);
with 'Getopt::Dakkar::Role::Piece';
# VERSION
# ABSTRACT: a command
@@ -8,8 +10,26 @@ has options => ( is => 'ro', isa => ArrayRef, default => sub { [] } );
has parameters => ( is => 'ro', isa => ArrayRef, default => sub { [] } );
has subcommands => ( is => 'ro', isa => ArrayRef, default => sub { [] } );
+has class => ( is => 'ro', isa => Str );
+has object => ( is => 'ro', isa => Object );
+has op => ( is => 'ro', isa => Str|CodeRef, default => 'merge_with_argpack' );
+
+sub make_stash($self,$argpack) {
+ if (my $o = $self->object) { return $o }
+
+ return unless $self->class;
+
+ my $class = use_module($self->class);
+ if (my $from_argpack = $class->can('new_from_argpack')) {
+ return $class->$from_argpack($argpack);
+ }
+ else {
+ return $class->new();
+ }
+}
+
sub parse($self,$args,$stash) {
- my $stash = $self->_parse($args,$stash);
+ $stash = $self->_parse($args,$stash);
if (my $op = $self->op) {
return $stash->$op();
}
@@ -18,17 +38,18 @@ sub parse($self,$args,$stash) {
sub _parse($self,$args,$stash) {
my $argpack = Getopt::Dakkar::ArgPack->new({getopt=>$self});
+ my @parameters = $self->parameters->@*;
while ($args->@*) {
my $this = $args->[0];
if ($self->_looks_like_option($this)
and not $self->_is_terminator($this)) {
- if (my $match = $self->_match_option($this)) {
+ if (my $option = $self->_match_option($this)) {
# ->parse will remove $this (or parts of
# it, if it's a bundle) and shift its own arguments
# out of $args
- my $option = $match->parse($args,$stash);
- $argpack->options->{$match->name} = $option;
+ my $option_value = $option->parse($args,$stash);
+ $argpack->options->{$option_value->name} = $option_value;
}
else {
Getopt::Dakkar::X::BadOption->throw({
@@ -36,15 +57,12 @@ sub _parse($self,$args,$stash) {
});
}
}
- elsif (my $match = $self->_match_subcommand($this)) {
+ elsif (my $subcommand = $self->_match_subcommand($this)) {
shift $args->@*;
- $stash //= $self->_make_stash($argpack);
- my $op = $self->op;
- $stash->$op($argpack);
- $match->parse($args,$stash);
+ $subcommand->parse($args,$stash);
}
- else {
- shift $args->@* if $self->_is_terminator($this);
+ elsif ($self->_is_terminator($this)) {
+ shift $args->@*;
for my $parameter ($self->parameters->@*) {
# ->parse will remove the argument(s) from $args
my $argument = $parameter->parse($args,$stash);
@@ -58,10 +76,19 @@ sub _parse($self,$args,$stash) {
args => $args,
});
}
- # hmmm. what about 'ls foo -l' ?
+ }
+ else {
+ my $next_parameter = shift @parameters
+ or last;
+ my $argument = $next_parameter->parse($args,$stash);
+ $argpack->arguments->{$argument->name} = $argument;
}
}
- return $stash;
+ my $new_stash = $self->make_stash($argpack) // $stash;
+ my $op = $self->op;
+ $new_stash->$op($argpack);
+
+ return $new_stash;
}
sub _is_terminator($self,$arg) { return $arg eq q{--} }