|
package Cmd; |
|
use strict; |
|
use warnings; |
|
use Data::Validator; |
|
|
|
sub new { |
|
my($class, $argv) = @_; |
|
my $args = delete $argv->{_}; |
|
bless { |
|
argv => $argv, |
|
args => $args, |
|
}, $class; |
|
} |
|
|
|
sub validate { |
|
my $self = shift; |
|
my $validator = Data::Validator->new( @_ ); |
|
$self->{argv} = $validator->validate( %{$self->{argv}} ); |
|
$self; |
|
} |
|
|
|
sub map { |
|
my $self = shift; |
|
my $cb = pop; |
|
my $argv = $self->{argv}; |
|
return if scalar(keys %{$argv}) != scalar @_; |
|
return if scalar(grep{ exists $argv->{$_} }@_) != scalar @_; |
|
# 制限Hashなので defined は使えない |
|
# return if scalar(grep{ defined $argv->{$_} }@_) != scalar @_; |
|
$cb->($argv, $self->{args}); |
|
exit 0; |
|
} |
|
|
|
1; |
|
|
|
package main; |
|
use strict; |
|
use warnings; |
|
use Smart::Options; |
|
use Mouse::Util::TypeConstraints; |
|
|
|
subtype 'Cmd::TypeWith' |
|
=> as 'Str' |
|
=> where { $_ eq 'm' or $_ eq 'p' or $_ eq 'r' } |
|
=> message { qq("with" option must be "m" or "p" or "r" ) } |
|
; |
|
|
|
my $cmd = Cmd->new( Smart::Options->new |
|
->options( |
|
h => { alias => 'help' }, |
|
dir => { default => '.' }, |
|
ls => { alias => 'list' }, |
|
l => { alias => 'loc' }, |
|
p => { alias => 'package_json' }, |
|
m => { alias => 'module' }, |
|
r => { alias => 'readme' }, |
|
lib => { alias => 'library' } |
|
)->boolean(qw{ |
|
help ls tree |
|
})->parse |
|
); |
|
|
|
$cmd->validate( |
|
dir => { isa => 'Str' }, |
|
help => { isa => 'Bool', optional => 1 }, |
|
list => { isa => 'Bool', optional => 1 }, |
|
tree => { isa => 'Bool', optional => 1 }, |
|
loc => { isa => 'Str', optional => 1 }, |
|
package_json => { isa => 'Str', optional => 1 }, |
|
module => { isa => 'Str', optional => 1 }, |
|
readme => { isa => 'Str', optional => 1 }, |
|
with => { isa => 'Cmd::TypeWith', optional => 1 }, |
|
library => { isa => 'Str', optional => 1 }, |
|
); |
|
|
|
push @{$cmd->{args}}, delete $cmd->{argv}{dir}; |
|
|
|
$cmd->map(qw/list/ => sub { |
|
my($argv, $args) = @_; |
|
warn qq("called list); |
|
}); |
|
$cmd->map(qw/loc with/ => sub { |
|
my($argv, $args) = @_; |
|
warn $argv->{loc}; |
|
warn $argv->{with}; |
|
}); |
|
$cmd->map(qw/loc library/ => sub { |
|
my($argv, $args) = @_; |
|
warn $argv->{loc}; |
|
warn $argv->{library}; |
|
}); |
|
$cmd->map(sub { |
|
my(undef, $args) = @_; |
|
warn $args->[0]; |
|
}); |
|
|
|
1; |
hayajo さんが Smart::Options::WithRule 書いてくれたので書きなおしてみた。