lib/Getopt/Dakkar/Option.pm


1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49

package Getopt::Dakkar::Option; 
use Getopt::Dakkar::Style qw(class);
use Getopt::Dakkar::OptionValue;
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->@*;
 
    # 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);
        $arguments{$argument->name} = $argument;
    }
 
    # then, remove the option and put the bundle back, if needed 
    if ($my_option =~ /^-[^-]{2,}/) { # we're in a bundle 
        $my_option =~ s{^-.}{-};
        unshift $args->@*, $my_option;
    }
 
    my $value = Getopt::Dakkar::OptionValue->new({
        name => $self->name,
        # needs a way to negate a boolean! 
        value => %arguments ? \%arguments : 1,
    });
 
    return $value;
}