summaryrefslogtreecommitdiff
path: root/lib
diff options
context:
space:
mode:
authordakkar <dakkar@thenautilus.net>2018-07-13 18:52:08 +0100
committerdakkar <dakkar@thenautilus.net>2018-07-13 18:52:08 +0100
commit9c7b213f58fe533953953e90b5bc77087ca4d45d (patch)
treec78cd04844a4ba1e92f1bf1dc29c14b3813e4bc7 /lib
parentI'm losing the plot, here (diff)
downloadGetopt-Dakkar-9c7b213f58fe533953953e90b5bc77087ca4d45d.tar.gz
Getopt-Dakkar-9c7b213f58fe533953953e90b5bc77087ca4d45d.tar.bz2
Getopt-Dakkar-9c7b213f58fe533953953e90b5bc77087ca4d45d.zip
we can now parse boolean optionsHEADmaster
Diffstat (limited to 'lib')
-rw-r--r--lib/Getopt/Dakkar.pm15
-rw-r--r--lib/Getopt/Dakkar/ArgPack.pm4
-rw-r--r--lib/Getopt/Dakkar/Argument.pm5
-rw-r--r--lib/Getopt/Dakkar/Option.pm17
-rw-r--r--lib/Getopt/Dakkar/OptionValue.pm5
-rw-r--r--lib/Getopt/Dakkar/Parameter.pm31
-rw-r--r--lib/Getopt/Dakkar/Role/Command.pm53
-rw-r--r--lib/Getopt/Dakkar/Role/Piece.pm16
-rw-r--r--lib/Getopt/Dakkar/Role/Value.pm7
-rw-r--r--lib/Getopt/Dakkar/Subcommand.pm5
-rw-r--r--lib/Getopt/Dakkar/X.pm12
11 files changed, 133 insertions, 37 deletions
diff --git a/lib/Getopt/Dakkar.pm b/lib/Getopt/Dakkar.pm
index 1432987..739985b 100644
--- a/lib/Getopt/Dakkar.pm
+++ b/lib/Getopt/Dakkar.pm
@@ -1,13 +1,22 @@
package Getopt::Dakkar;
use Getopt::Dakkar::Style qw(class);
-use Module::Runtime qw(use_module);
# VERSION
# ABSTRACT: the best command line parser ever
with 'Getopt::Dakkar::Role::Command';
has '+name' => ( default => $0 );
+has '+class' => ( default => 'Getopt::Dakkar::Stash' );
-sub go($self,$args=\@ARGV) {
- return $self->parse($args,undef);
+sub parse($self,$args=\@ARGV,$=) {
+ my $stash = $self->_parse($args,undef) //
+ $self->make_stash(Getopt::Dakkar::ArgPack->new());
+ # we're top-level, we should really have used all the command line
+ # elements
+ if ($args->@*) {
+ Getopt::Dakkar::X::ExtraArgs->throw({
+ args => $args,
+ });
+ }
+ return $stash;
}
diff --git a/lib/Getopt/Dakkar/ArgPack.pm b/lib/Getopt/Dakkar/ArgPack.pm
index ee710e0..4337ce4 100644
--- a/lib/Getopt/Dakkar/ArgPack.pm
+++ b/lib/Getopt/Dakkar/ArgPack.pm
@@ -7,5 +7,5 @@ use Getopt::Dakkar::Style qw(class);
has getopt => ( is => 'ro', required => 1, weak_ref => 1 );
-has options => ( is => 'ro' );
-has arguments => ( is => 'ro' );
+has options => ( is => 'ro', isa => HashRef, default => sub { +{} } );
+has arguments => ( is => 'ro', isa => HashRef, default => sub { +{} } );
diff --git a/lib/Getopt/Dakkar/Argument.pm b/lib/Getopt/Dakkar/Argument.pm
new file mode 100644
index 0000000..1ee721c
--- /dev/null
+++ b/lib/Getopt/Dakkar/Argument.pm
@@ -0,0 +1,5 @@
+package Getopt::Dakkar::Argument;
+use Getopt::Dakkar::Style qw(class);
+with 'Getopt::Dakkar::Role::Value';
+# VERSION
+# ABSTRACT: the value of a parameter
diff --git a/lib/Getopt/Dakkar/Option.pm b/lib/Getopt/Dakkar/Option.pm
index 0dfd882..077f7be 100644
--- a/lib/Getopt/Dakkar/Option.pm
+++ b/lib/Getopt/Dakkar/Option.pm
@@ -1,5 +1,6 @@
package Getopt::Dakkar::Option;
use Getopt::Dakkar::Style qw(class);
+use Getopt::Dakkar::OptionValue;
with 'Getopt::Dakkar::Role::Piece';
# VERSION
# ABSTRACT: an option
@@ -23,16 +24,26 @@ sub match($self,$arg) {
sub parse($self,$args,$stash) {
my $my_option = shift $args->@*;
+ # this will need to be extracted and made dependent on the type!
+
+ my %arguments;
# first, get arguments if needed
for my $parameter ($self->parameters->@*) {
my $argument = $parameter->parse($args,$stash);
- # aaarg,
+ $arguments{$argument->name} = $argument;
}
# then, remove the option and put the bundle back, if needed
- if ($my_option =~ /^-[^-]+/) { # we're in a bundle
+ if ($my_option =~ /^-[^-]{2,}/) { # we're in a bundle
$my_option =~ s{^-.}{-};
unshift $args->@*, $my_option;
}
- return $the_option_argument;
+
+ my $value = Getopt::Dakkar::OptionValue->new({
+ name => $self->name,
+ # needs a way to negate a boolean!
+ value => %arguments ? \%arguments : 1,
+ });
+
+ return $value;
}
diff --git a/lib/Getopt/Dakkar/OptionValue.pm b/lib/Getopt/Dakkar/OptionValue.pm
new file mode 100644
index 0000000..d19cf61
--- /dev/null
+++ b/lib/Getopt/Dakkar/OptionValue.pm
@@ -0,0 +1,5 @@
+package Getopt::Dakkar::OptionValue;
+use Getopt::Dakkar::Style qw(class);
+with 'Getopt::Dakkar::Role::Value';
+# VERSION
+# ABSTRACT: the value of an option
diff --git a/lib/Getopt/Dakkar/Parameter.pm b/lib/Getopt/Dakkar/Parameter.pm
new file mode 100644
index 0000000..d544c74
--- /dev/null
+++ b/lib/Getopt/Dakkar/Parameter.pm
@@ -0,0 +1,31 @@
+package Getopt::Dakkar::Parameter;
+use Getopt::Dakkar::Style qw(class);
+use Getopt::Dakkar::Argument;
+with 'Getopt::Dakkar::Role::Piece';
+# VERSION
+# ABSTRACT: a (positional) parameter
+
+# this will need to be generalised and depend on the type
+has is_slurpy => ( is => 'ro', isa => Bool, default => 0 );
+
+sub match($self,$arg) {
+ # this may need to throw if the type is wrong?
+ return 1;
+}
+
+sub parse($self,$args,$stash) {
+ if ($self->is_slurpy) {
+ my $value = [ $args->@* ];
+ $args->@* = ();
+ return Getopt::Dakkar::Argument->new({
+ name => $self->name,
+ value => $value,
+ });
+ }
+ else {
+ return Getopt::Dakkar::Argument->new({
+ name => $self->name,
+ value => (shift $args->@*),
+ });
+ }
+}
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{--} }
diff --git a/lib/Getopt/Dakkar/Role/Piece.pm b/lib/Getopt/Dakkar/Role/Piece.pm
index 81c89e7..5b7609d 100644
--- a/lib/Getopt/Dakkar/Role/Piece.pm
+++ b/lib/Getopt/Dakkar/Role/Piece.pm
@@ -12,20 +12,4 @@ has matching_strings => (
);
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 );
-
-sub make_stash($self,$argpack) {
- if (my $o = $self->object) { return $o }
-
- my $class = use_module($self->class);
- if (my $from_argpack = $class->can('new_from_argpack')) {
- return $class->$from_argpack($argpack);
- }
- else {
- return $class->new();
- }
-}
-
requires qw(parse match);
diff --git a/lib/Getopt/Dakkar/Role/Value.pm b/lib/Getopt/Dakkar/Role/Value.pm
new file mode 100644
index 0000000..ef4d4de
--- /dev/null
+++ b/lib/Getopt/Dakkar/Role/Value.pm
@@ -0,0 +1,7 @@
+package Getopt::Dakkar::Role::Value;
+use Getopt::Dakkar::Style qw(role);
+# VERSION
+# ABSTRACT: a value
+
+has name => ( is => 'ro', isa => Str, required => 1 );
+has value => ( is => 'ro', required => 1 );
diff --git a/lib/Getopt/Dakkar/Subcommand.pm b/lib/Getopt/Dakkar/Subcommand.pm
new file mode 100644
index 0000000..92438c3
--- /dev/null
+++ b/lib/Getopt/Dakkar/Subcommand.pm
@@ -0,0 +1,5 @@
+package Getopt::Dakkar::Subcommand;
+use Getopt::Dakkar::Style qw(class);
+with 'Getopt::Dakkar::Role::Command';
+# VERSION
+# ABSTRACT: a sub command
diff --git a/lib/Getopt/Dakkar/X.pm b/lib/Getopt/Dakkar/X.pm
index e595b71..f705ed5 100644
--- a/lib/Getopt/Dakkar/X.pm
+++ b/lib/Getopt/Dakkar/X.pm
@@ -2,3 +2,15 @@ package Getopt::Dakkar::X;
use Getopt::Dakkar::Style;
# VERSION
# ABSTRACT: exceptions
+
+package Getopt::Dakkar::X::ExtraArgs {
+ use Getopt::Dakkar::Style qw(class);
+ with 'Throwable';
+ has args => ( is => 'ro', isa => ArrayRef, required => 1 );
+};
+
+package Getopt::Dakkar::X::BadOption {
+ use Getopt::Dakkar::Style qw(class);
+ with 'Throwable';
+ has input => ( is => 'ro', isa => Str, required => 1 );
+};