1# ============================================================================
2package MooseX::App::Plugin::MutexGroup::Meta::Class;
3# ============================================================================
4
5use Moose::Role;
6use namespace::autoclean;
7
8around 'command_check_attributes' => sub {
9    my ( $orig, $self, $command_meta, $errors, $params ) = @_;
10    $command_meta ||= $self;
11
12    my %mutex_groups;
13    foreach my $attribute (
14        $self->command_usage_attributes( $command_meta, 'all' ) ) {
15        push @{ $mutex_groups{ $attribute->mutexgroup } }, $attribute
16            if $attribute->can('mutexgroup')
17            && defined $attribute->mutexgroup;
18    }
19
20    foreach my $options ( values %mutex_groups ) {
21        my @initialized_options =
22            grep { defined $params->{ $_->name } }
23            @$options;
24
25        unless ( scalar @initialized_options == 1 ) {
26            my $error_msg;
27
28            if (scalar @initialized_options == 0) {
29                my $last = pop @$options;
30                $error_msg = "Either ".
31                    join(",", map { $_->cmd_name_primary } @$options).
32                    " or ".
33                    $last->cmd_name_primary.
34                    " must be specified";
35            } else {
36                my @list = map { $_->cmd_name_primary } @initialized_options;
37                my $last = pop(@list);
38
39                $error_msg = "Options ".
40                    join(",",@list).
41                    " and ".
42                    $last.
43                    " are mutally exclusive";
44            }
45
46            push @$errors,
47                $self->command_message(
48                header => $error_msg,
49                type   => "error",
50            );
51        }
52    }
53
54    return $self->$orig( $command_meta, $errors, $params );
55};
56
571;
58