File Coverage

blib/lib/Bash/Completion/Plugins/pinto.pm

Criterion	Covered	Total	%
statement	52	91	57.1
branch	5	8	62.5
condition	8	8	100.0
subroutine	8	11	72.7
pod	2	2	100.0
total	75	120	62.5

## no critic (RequireUseStrict)
package Bash::Completion::Plugins::pinto;
# git description: v0.002-1-g02cd2bc

BEGIN {
  $Bash::Completion::Plugins::pinto::AUTHORITY = 'cpan:SCHWIGON';
}
{
  $Bash::Completion::Plugins::pinto::VERSION = '0.003';
}
# ABSTRACT: Bash completion for pinto

## use critic (RequireUseStrict)
use strict;
use warnings;
use feature 'switch';
use parent 'Bash::Completion::Plugin';

use Bash::Completion::Utils qw(command_in_path);

my @pinto_commands = qw/commands help add copy
                           delete edit index init
                           install list manual merge
                           new nop pin props pull
                           stacks statistics unpin
                           verify version
                          /;

my @pinto_options = qw/-h --help
                       -r --root
                       -q --quiet
                       -v --verbose
                       --nocolor
                       /;

sub should_activate {
    return [ grep { command_in_path($_) } qw/pinto/ ];
}

sub _extract_stack {
    my ( $stack ) = @_;

    #$stack =~ s/\@.*//;
    return $stack;
}

sub _get_stacks {
    my @stacks = split /\n/, qx(pinto stacks);
    my ( $current_stack ) = grep { /^\*\s*/ } @stacks;
    ( $current_stack )    = $current_stack =~ /^\*\s*(\S+)/;

    $current_stack = _extract_stack($current_stack);

    return ( $current_stack, map { /^\*?\s*(?\S+)/; $+{'name'} } @stacks );
}

sub complete {
    my ( $self, $r ) = @_;

    my $word = $r->word;

    if ($word =~ /^-/) {
            $r->candidates(grep { /^\Q$word\E/ } @pinto_options);
    } else {
            my @args = $r->args;

            my @orig_args = @args;

            shift @args; # get rid of 'pinto'

            # get rid of (-rFOO|-r FOO|--root FOO|--root=FOO)
            if ($args[0] and $args[0] =~ qr/^(?:-r|--root)$/) {
                    if ($args[0] =~ qr/^(?:--root=)$/) {
                            shift @args;
                    } elsif ($args[1]) {
                            shift @args;
                            shift @args;
                    }
            }

            shift @args until @args == 0 || $args[0] !~ /^-/;

            my $command = $args[0] // '';

            my @options = ();
            given($command) {
                    when ("add")        { @options = qw(--author --dryrun --norecurse --pin --stack); }
                    when ("copy")       { @options = qw(--description --dryrun); }
                    when ("edit")       { @options = qw(--default --dryrun --properties -P); }
                    when ("init")       { @options = qw(--source); }
                    when ("install")    { @options = qw(--cpanm-exe --cpanm
                                                        --cpanm-options -o
                                                        -l --local-lib --local-lib-contained
                                                        --pull
                                                        --stack
                                                      ); }
                    when ("list")       { @options = qw(--author -A
                                                        --distributions -D
                                                        --format
                                                        --packages -P
                                                        --pinned
                                                        --stack -s
                                                      ); }
                    when ("merge")      { @options = qw(--dryrun); }
                    when ("new")        { @options = qw(--dryrun --description); }
                    when ("nop")        { @options = qw(--sleep); }
                    when ("pin")        { @options = qw(--dryrun --stack); }
                    when ("props")      { @options = qw(--format); }
                    when ("pull")       { @options = qw(--dryrun --norecurse --stack); }
                    when ("stacks")     { @options = qw(--format); }
                    when ("unpin")      { @options = qw(--dryrun --stack); }
                    default { };
            }

            given($command) {
                    when($command eq $word) {
                            $r->candidates(grep { /^\Q$word\E/ }
                                           ( @pinto_commands, @pinto_options ));
                    }
                    ##_get_stacks() is quite slow for my demanding taste (due to slow pinto startup time)
                    when(qr/^(?:copy|delete|index|list|merge|pin|unpin)$/) {
                            my ( $current_stack, @stacks ) = _get_stacks();
                            $r->candidates(grep { /^\Q$word\E/ } ( @options, @stacks ));
                    }
                    when(qr/^(?:manual|help)$/) {
                            $r->candidates(grep { /^\Q$word\E/ }
                                           ( @pinto_commands ));
                    }
                    default {
                            # all other commands (including unrecognized ones) get
                            # no completions
                            $r->candidates(grep { /^\Q$word\E/ } ( @options ));
                    }
            }
    }
}

1;



=pod

=encoding utf-8

=head1 NAME

Bash::Completion::Plugins::pinto - Bash completion for pinto

=head1 DESCRIPTION

L support for L.  Completes pinto
commands and options.

=head1 SEE ALSO

L, L, L

=head1 ACKNOWLEDGMENTS

Derived from L by Rob Hoelz.

=begin comment

=over

=item should_activate

=item complete

=back

=end comment

=head1 AUTHOR

Steffen Schwigon

=head1 COPYRIGHT AND LICENSE

This software is copyright (c) 2012 by Steffen Schwigon.

This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.

=cut


__END__