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
50
51
52
53
54
55
56
57
|
# ============================================================================
package MooseX::App::Plugin::MutexGroup::Meta::Class;
# ============================================================================
use Moose::Role;
use namespace::autoclean;
around 'command_check_attributes' => sub {
my ( $orig, $self, $command_meta, $errors, $params ) = @_;
$command_meta ||= $self;
my %mutex_groups;
foreach my $attribute (
$self->command_usage_attributes( $command_meta, 'all' ) ) {
push @{ $mutex_groups{ $attribute->mutexgroup } }, $attribute
if $attribute->can('mutexgroup')
&& defined $attribute->mutexgroup;
}
foreach my $options ( values %mutex_groups ) {
my @initialized_options =
grep { defined $params->{ $_->name } }
@$options;
unless ( scalar @initialized_options == 1 ) {
my $error_msg;
if (scalar @initialized_options == 0) {
my $last = pop @$options;
$error_msg = "Either ".
join(",", map { $_->cmd_name_primary } @$options).
" or ".
$last->cmd_name_primary.
" must be specified";
} else {
my @list = map { $_->cmd_name_primary } @initialized_options;
my $last = pop(@list);
$error_msg = "Options ".
join(",",@list).
" and ".
$last.
" are mutally exclusive";
}
push @$errors,
$self->command_message(
header => $error_msg,
type => "error",
);
}
}
return $self->$orig( $command_meta, $errors, $params );
};
1;
|
