ちょっとしたコマンドラインツールを書くのに、Smart::Options は入力データをパースするのに楽ちんです。 なんですけど、もう少し複雑なことをやらせようとするとデータのバリデーションした方がいいなってなる。なので、Data::Validator を通してバリデーションさせてみる
制限ハッシュで、そのハッシュに任意のキーがあるかチェックするのに defined 使ったら "Attempt to access disallowed key 'キー名' in a restricted hash ..." って怒られて止まっちゃった。 exists 使ったらチェックできた
| 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 書いてくれたので書きなおしてみた。