File Coverage

blib/lib/App/Cmd/Subdispatch/DashedStyle.pm

Criterion	Covered	Total	%
statement	10	26	38.4
branch	0	2	0.0
condition			n/a
subroutine	4	6	66.6
pod	2	2	100.0
total	16	36	44.4

use strict;
use warnings;

package App::Cmd::Subdispatch::DashedStyle 0.334;

use App::Cmd::Subdispatch;
BEGIN { our @ISA = 'App::Cmd::Subdispatch' };

# ABSTRACT: "app cmd --subcmd" style subdispatching

#pod =method get_command
#pod
#pod   my ($subcommand, $opt, $args) = $subdispatch->get_command(@args)
#pod
#pod A version of get_command that chooses commands as options in the following
#pod style:
#pod
#pod   mytool mycommand --mysubcommand
#pod
#pod =cut

sub get_command {
	my ($self, @args) = @_;

	my (undef, $opt, @sub_args)
    = $self->App::Cmd::Command::prepare($self->app, @args);

	if (my $cmd = delete $opt->{subcommand}) {
		delete $opt->{$cmd}; # useless boolean
		return ($cmd, $opt, @sub_args);
	} else {
    return (undef, $opt, @sub_args);
  }
}

#pod =method opt_spec
#pod
#pod A version of C that calculates the getopt specification from the
#pod subcommands.
#pod
#pod =cut

sub opt_spec {
	my ($self, $app) = @_;

	my $subcommands = $self->_command;
	my %plugins = map {
		$_ => [ $_->command_names ],
	} values %$subcommands;

	foreach my $opt_spec (values %plugins) {
		$opt_spec = join("|", grep { /^\w/ } @$opt_spec);
	}

	my @subcommands = map { [ $plugins{$_} =>  $_->abstract ] } keys %plugins;

	return (
		[ subcommand => hidden => { one_of => \@subcommands } ],
		$self->global_opt_spec($app),
		{ getopt_conf => [ 'pass_through' ] },
	);
}

1;

__END__