From c11ab0abb790e519d63c47c37962c31dc032014a Mon Sep 17 00:00:00 2001
From: dakkar <dakkar@thenautilus.net>
Date: Fri, 13 Jul 2018 13:32:45 +0100
Subject: I'm losing the plot, here

---
 lib/Getopt/Dakkar/Role/Command.pm | 20 +++++++++++++-------
 lib/Getopt/Dakkar/Role/Piece.pm   | 10 +++++++++-
 2 files changed, 22 insertions(+), 8 deletions(-)

(limited to 'lib/Getopt/Dakkar/Role')

diff --git a/lib/Getopt/Dakkar/Role/Command.pm b/lib/Getopt/Dakkar/Role/Command.pm
index 8fa491b..444a9a4 100644
--- a/lib/Getopt/Dakkar/Role/Command.pm
+++ b/lib/Getopt/Dakkar/Role/Command.pm
@@ -8,14 +8,15 @@ has options => ( is => 'ro', isa => ArrayRef, default => sub { [] } );
 has parameters => ( is => 'ro', isa => ArrayRef, default => sub { [] } );
 has subcommands => ( is => 'ro', isa => ArrayRef, default => sub { [] } );
 
-sub parse($self,$args=undef) {
-    my $stash = $self->_parse($args);
+sub parse($self,$args,$stash) {
+    my $stash = $self->_parse($args,$stash);
     if (my $op = $self->op) {
-        $stash->$op();
+        return $stash->$op();
     }
+    return $stash;
 }
 
-sub _parse($self,$args,$stash=undef) {
+sub _parse($self,$args,$stash) {
     my $argpack = Getopt::Dakkar::ArgPack->new({getopt=>$self});
     while ($args->@*) {
         my $this = $args->[0];
@@ -26,7 +27,7 @@ sub _parse($self,$args,$stash=undef) {
                 # ->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,$self);
+                my $option = $match->parse($args,$stash);
                 $argpack->options->{$match->name} = $option;
             }
             else {
@@ -40,13 +41,13 @@ sub _parse($self,$args,$stash=undef) {
             $stash //= $self->_make_stash($argpack);
             my $op = $self->op;
             $stash->$op($argpack);
-            $match->_parse($args,$stash);
+            $match->parse($args,$stash);
         }
         else {
             shift $args->@* if $self->_is_terminator($this);
             for my $parameter ($self->parameters->@*) {
                 # ->parse will remove the argument(s) from $args
-                my $argument = $parameter->parse($args,$self);
+                my $argument = $parameter->parse($args,$stash);
                 $argpack->arguments->{$argument->name} = $argument;
             }
 
@@ -57,6 +58,7 @@ sub _parse($self,$args,$stash=undef) {
                     args => $args,
                 });
             }
+            # hmmm. what about 'ls foo -l' ?
         }
     }
     return $stash;
@@ -76,3 +78,7 @@ sub _match_subcommand($self,$arg) {
     }
     return undef;
 }
+
+sub match($self,$arg) {
+    return !! grep { $_ eq $arg } $self->matching_strings->@*;
+}
diff --git a/lib/Getopt/Dakkar/Role/Piece.pm b/lib/Getopt/Dakkar/Role/Piece.pm
index 144f9e7..81c89e7 100644
--- a/lib/Getopt/Dakkar/Role/Piece.pm
+++ b/lib/Getopt/Dakkar/Role/Piece.pm
@@ -4,6 +4,14 @@ use Getopt::Dakkar::Style qw(role);
 # ABSTRACT: a piece
 
 has name => ( is => 'ro', isa => Str, required => 1 );
+has aliases => ( is => 'ro', isa => ArrayRef[Str], default => sub { [] } );
+has matching_strings => (
+    is => 'lazy',
+    isa => ArrayRef[Str],
+    init_arg => 'matches',
+);
+sub _build_matching_strings($self) { [ $self->name, $self->aliases->@* ] }
+
 has class => ( is => 'ro', isa => ClassName, default => 'Getopt::Dakkar::Stash' );
 has object => ( is => 'ro', isa => Object );
 has op => ( is => 'ro', isa => Str|CodeRef );
@@ -20,4 +28,4 @@ sub make_stash($self,$argpack) {
     }
 }
 
-requires 'parse';
+requires qw(parse match);
-- 
cgit v1.2.3