From 9c7b213f58fe533953953e90b5bc77087ca4d45d Mon Sep 17 00:00:00 2001
From: dakkar <dakkar@thenautilus.net>
Date: Fri, 13 Jul 2018 18:52:08 +0100
Subject: we can now parse boolean options

---
 lib/Getopt/Dakkar/Role/Command.pm | 53 +++++++++++++++++++++++++++++----------
 1 file changed, 40 insertions(+), 13 deletions(-)

(limited to 'lib/Getopt/Dakkar/Role/Command.pm')

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{--} }
-- 
cgit v1.2.3