summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--lib/Getopt/Dakkar.pm4
-rw-r--r--lib/Getopt/Dakkar/Option.pm38
-rw-r--r--lib/Getopt/Dakkar/Role/Command.pm20
-rw-r--r--lib/Getopt/Dakkar/Role/Piece.pm10
4 files changed, 64 insertions, 8 deletions
diff --git a/lib/Getopt/Dakkar.pm b/lib/Getopt/Dakkar.pm
index f35147b..1432987 100644
--- a/lib/Getopt/Dakkar.pm
+++ b/lib/Getopt/Dakkar.pm
@@ -7,3 +7,7 @@ use Module::Runtime qw(use_module);
with 'Getopt::Dakkar::Role::Command';
has '+name' => ( default => $0 );
+
+sub go($self,$args=\@ARGV) {
+ return $self->parse($args,undef);
+}
diff --git a/lib/Getopt/Dakkar/Option.pm b/lib/Getopt/Dakkar/Option.pm
new file mode 100644
index 0000000..0dfd882
--- /dev/null
+++ b/lib/Getopt/Dakkar/Option.pm
@@ -0,0 +1,38 @@
+package Getopt::Dakkar::Option;
+use Getopt::Dakkar::Style qw(class);
+with 'Getopt::Dakkar::Role::Piece';
+# VERSION
+# ABSTRACT: an option
+
+has can_bundle => ( is => 'ro', isa => Bool, default => 0 );
+has parameters => ( is => 'ro', isa => ArrayRef, default => sub { [] } );
+
+sub match($self,$arg) {
+ for my $candidate ($self->matching_strings->@*) {
+ if (length($candidate)==1) {
+ return 1 if $arg eq "-$candidate";
+ return 1 if $self->can_bundle && $arg =~ /^-\Q$candidate/;
+ }
+ else {
+ return 1 if $arg eq "--$candidate";
+ }
+ }
+ return 0;
+}
+
+sub parse($self,$args,$stash) {
+ my $my_option = shift $args->@*;
+
+ # first, get arguments if needed
+ for my $parameter ($self->parameters->@*) {
+ my $argument = $parameter->parse($args,$stash);
+ # aaarg,
+ }
+
+ # then, remove the option and put the bundle back, if needed
+ if ($my_option =~ /^-[^-]+/) { # we're in a bundle
+ $my_option =~ s{^-.}{-};
+ unshift $args->@*, $my_option;
+ }
+ return $the_option_argument;
+}
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);