From 7fce4340deb0b6337bbd7ef6071ee42529db222d Mon Sep 17 00:00:00 2001
From: dakkar <dakkar@thenautilus.net>
Date: Fri, 13 Jul 2018 13:09:26 +0100
Subject: vaguely parse commands

---
 lib/Getopt/Dakkar.pm              |  5 ++-
 lib/Getopt/Dakkar/ArgPack.pm      | 11 ++++++
 lib/Getopt/Dakkar/Role/Command.pm | 76 +++++++++++++++++++++++++++++++++++++++
 lib/Getopt/Dakkar/Role/Piece.pm   | 22 ++++++++++++
 lib/Getopt/Dakkar/Stash.pm        | 23 ++++++++++++
 lib/Getopt/Dakkar/Style.pm        | 10 ++----
 lib/Getopt/Dakkar/X.pm            |  4 +++
 7 files changed, 143 insertions(+), 8 deletions(-)
 create mode 100644 lib/Getopt/Dakkar/ArgPack.pm
 create mode 100644 lib/Getopt/Dakkar/Role/Command.pm
 create mode 100644 lib/Getopt/Dakkar/Role/Piece.pm
 create mode 100644 lib/Getopt/Dakkar/Stash.pm
 create mode 100644 lib/Getopt/Dakkar/X.pm

(limited to 'lib/Getopt')

diff --git a/lib/Getopt/Dakkar.pm b/lib/Getopt/Dakkar.pm
index d8edd0c..b43c24e 100644
--- a/lib/Getopt/Dakkar.pm
+++ b/lib/Getopt/Dakkar.pm
@@ -1,6 +1,9 @@
 package Getopt::Dakkar;
-use Getopt::Dakkar::Style;
+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';
+
 1;
diff --git a/lib/Getopt/Dakkar/ArgPack.pm b/lib/Getopt/Dakkar/ArgPack.pm
new file mode 100644
index 0000000..ee710e0
--- /dev/null
+++ b/lib/Getopt/Dakkar/ArgPack.pm
@@ -0,0 +1,11 @@
+package Getopt::Dakkar::ArgPack;
+use Getopt::Dakkar::Style qw(class);
+# VERSION
+# ABSTRACT: pack of arguments
+
+# this needs work
+
+has getopt => ( is => 'ro', required => 1, weak_ref => 1 );
+
+has options => ( is => 'ro' );
+has arguments => ( is => 'ro' );
diff --git a/lib/Getopt/Dakkar/Role/Command.pm b/lib/Getopt/Dakkar/Role/Command.pm
new file mode 100644
index 0000000..b96c410
--- /dev/null
+++ b/lib/Getopt/Dakkar/Role/Command.pm
@@ -0,0 +1,76 @@
+package Getopt::Dakkar::Role::Command;
+use Getopt::Dakkar::Style qw(role);
+with 'Getopt::Dakkar::Role::Piece';
+# VERSION
+# ABSTRACT: a command
+
+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);
+    if (my $op = $self->op) {
+        $stash->$op();
+    }
+}
+
+sub _parse($self,$args,$stash=undef) {
+    my $argpack = Getopt::Dakkar::ArgPack->new({getopt=>$self});
+    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)) {
+                # ->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);
+                $argpack->options->{$match->name} = $option;
+            }
+            else {
+                Getopt::Dakkar::X::BadOption->throw({
+                    input => $this,
+                });
+            }
+        }
+        elsif (my $match = $self->_match_subcommand($this)) {
+            shift $args->@*;
+            $stash //= $self->_make_stash($argpack);
+            my $op = $self->op;
+            $stash->$op($argpack);
+            $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);
+                $argpack->arguments->{$argument->name} = $argument;
+            }
+
+            # if we've parsed all arguments, and there's still stuff
+            # in the input, something is wrong: complain
+            if ($args->@*) {
+                Getopt::Dakkar::X::ExtraArgs->throw({
+                    args => $args,
+                });
+            }
+        }
+    }
+    return $stash;
+}
+
+sub _is_terminator($self,$arg) { return $arg eq q{--} }
+sub _looks_like_option($self,$arg) { return $arg =~ /^-/ }
+sub _match_option($self,$arg) {
+    for my $option ($self->options->@*) {
+        return $option if $option->match($arg);
+    }
+}
+sub _match_subcommand($self,$arg) {
+    for my $subcommand ($self->subcommands->@*) {
+        return $subcommand if $subcommand->match($arg);
+    }
+}
diff --git a/lib/Getopt/Dakkar/Role/Piece.pm b/lib/Getopt/Dakkar/Role/Piece.pm
new file mode 100644
index 0000000..d981095
--- /dev/null
+++ b/lib/Getopt/Dakkar/Role/Piece.pm
@@ -0,0 +1,22 @@
+package Getopt::Dakkar::Role::Piece;
+use Getopt::Dakkar::Style qw(role);
+# VERSION
+# ABSTRACT: a piece
+
+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 'parse';
diff --git a/lib/Getopt/Dakkar/Stash.pm b/lib/Getopt/Dakkar/Stash.pm
new file mode 100644
index 0000000..2d0d568
--- /dev/null
+++ b/lib/Getopt/Dakkar/Stash.pm
@@ -0,0 +1,23 @@
+package Getopt::Dakkar::Stash;
+use Getopt::Dakkar::Style qw(class);
+# VERSION
+# ABSTRACT: a stash
+
+has options => ( is => 'ro' );
+has arguments => ( is => 'ro' );
+
+sub new_from_argpack($class,$argpack) {
+    return $class->new({
+        options => $argpack->options,
+        arguments => $argpack->arguments,
+    });
+}
+
+sub merge_with_argpack($self,$argpack) {
+    for my $f (qw(options arguments)) {
+        my $this = $self->$f;
+        my $that = $argpack->$f;
+        $this->{$_} = $that->{$_} for keys $that->%*;
+    }
+    return $self;
+}
diff --git a/lib/Getopt/Dakkar/Style.pm b/lib/Getopt/Dakkar/Style.pm
index e843262..5246a95 100644
--- a/lib/Getopt/Dakkar/Style.pm
+++ b/lib/Getopt/Dakkar/Style.pm
@@ -1,12 +1,8 @@
 package Getopt::Dakkar::Style;
 use 5.026;
-use strictures 2;
+use strictures version => 2;
 use true;
 use Import::Into;
-use Try::Tiny ();
-use Carp ();
-use feature ();
-use experimental ();
 use Path::Tiny ();
 
 # VERSION
@@ -57,11 +53,11 @@ sub import {
     my $caller = caller();
 
     strict->import();
-    feature->import(':5.26');
+    feature->import::into($caller, ':5.26');
     Try::Tiny->import::into($caller);
     Carp->import::into($caller);
-    feature->import::into($caller, ':5.26');
     true->import({ into =>  $caller });
+    Getopt::Dakkar::X->import::into($caller);
 
     my %arg = map { $_ => 1 } @args;
     if ($arg{class}) {
diff --git a/lib/Getopt/Dakkar/X.pm b/lib/Getopt/Dakkar/X.pm
new file mode 100644
index 0000000..e595b71
--- /dev/null
+++ b/lib/Getopt/Dakkar/X.pm
@@ -0,0 +1,4 @@
+package Getopt::Dakkar::X;
+use Getopt::Dakkar::Style;
+# VERSION
+# ABSTRACT: exceptions
-- 
cgit v1.2.3