File Coverage

blib/lib/Getopt/Long/Complete.pm

Criterion	Covered	Total	%
statement	22	67	32.8
branch	8	30	26.6
condition	1	8	12.5
subroutine	4	10	40.0
pod	7	7	100.0
total	42	122	34.4

## no critic (Modules::ProhibitAutomaticExportation)

package Getopt::Long::Complete;

our $AUTHORITY = 'cpan:PERLANCAR'; # AUTHORITY
our $DATE = '2020-04-16'; # DATE
our $DIST = 'Getopt-Long-Complete'; # DIST
our $VERSION = '0.315'; # VERSION

use strict;
use warnings;

require Exporter;
our @ISA = qw(Exporter);
our @EXPORT = qw(
                    GetOptions

                    $REQUIRE_ORDER $PERMUTE $RETURN_IN_ORDER
               );
our @EXPORT_OK = qw(
                    GetOptionsWithCompletion

                    GetOptionsFromArray
                    GetOptionsFromString
                    Configure
                    HelpMessage
                    VersionMessage
               );

# we don't want to always load Getopt::Long to avoid startup overhead.
our ($REQUIRE_ORDER, $PERMUTE, $RETURN_IN_ORDER) = (0..2); # copied from Getopt::Long
sub GetOptionsFromArray  { require Getopt::Long; goto &Getopt::Long::GetOptionsFromArray }
sub GetOptionsFromString { require Getopt::Long; goto &Getopt::Long::GetOptionsFromString }
sub Configure            { require Getopt::Long; goto &Getopt::Long::Configure }
sub HelpMessage          { require Getopt::Long; goto &Getopt::Long::HelpMessage }
sub VersionMessage       { require Getopt::Long; goto &Getopt::Long::VersionMessage }

# default follows Getopt::Long
our $opt_permute = $ENV{POSIXLY_CORRECT} ? 0 : 1;
our $opt_pass_through = 0;

our $opt_bundling = 1; # in Getopt::Long the default is off

sub GetOptionsWithCompletion {
    my $comp = shift;

    my $hash;
    my $ospec;
    if (ref($_[0]) eq 'HASH') {
        $hash = shift;
        for (my $i = 0; $i < @_; $i++) {
            if (($i+1 < @_) && (ref $_[$i+1])) {
                $ospec->{$_[$i]} = $_[$i+1];
                $i++;
            } else {
                $ospec->{$_[$i]} = sub {};
            }
        }
    } else {
        $ospec = \@_;
    }

    my $shell;
    if ($ENV{COMP_SHELL}) {
        ($shell = $ENV{COMP_SHELL}) =~ s!.+/!!;
    } elsif ($ENV{COMMAND_LINE}) {
        $shell = 'tcsh';
    } else {
        $shell = 'bash';
    }

    if ($ENV{COMP_LINE} || $ENV{COMMAND_LINE}) {
        my ($words, $cword);
        if ($ENV{COMP_LINE}) {
            require Complete::Bash;
            ($words,$cword) = @{ Complete::Bash::parse_cmdline(undef, undef, {truncate_current_word=>1}) };
            ($words,$cword) = @{ Complete::Bash::join_wordbreak_words($words, $cword) };
        } elsif ($ENV{COMMAND_LINE}) {
            require Complete::Tcsh;
            $shell ||= 'tcsh';
            ($words, $cword) = @{ Complete::Tcsh::parse_cmdline() };
        }

        require Complete::Getopt::Long;

        shift @$words; $cword--; # strip program name
        my $compres = Complete::Getopt::Long::complete_cli_arg(
            words => $words, cword => $cword, getopt_spec => $ospec,
            completion => $comp,
            bundling => $opt_bundling,
        );

        if ($shell eq 'bash') {
            require Complete::Bash;
            print Complete::Bash::format_completion(
                $compres, {word=>$words->[$cword]});
        } elsif ($shell eq 'fish') {
            require Complete::Fish;
            print Complete::Bash::format_completion(
                $compres, {word=>$words->[$cword]});
        } elsif ($shell eq 'tcsh') {
            require Complete::Tcsh;
            print Complete::Tcsh::format_completion($compres);
        } elsif ($shell eq 'zsh') {
            require Complete::Zsh;
            print Complete::Zsh::format_completion($compres);
        } else {
            die "Unknown shell '$shell'";
        }

        exit 0;
    }

    require Getopt::Long;
    my $old_conf = Getopt::Long::Configure(
        'no_ignore_case',
        'no_getopt_compat',
        'gnu_compat',
        $opt_bundling ? 'bundling' : 'no_bundling',
        $opt_permute ? 'permute' : 'no_permute',
        $opt_pass_through ? 'pass_through' : 'no_pass_through',
    );
    my $res;
    if ($hash) {
        $res = Getopt::Long::GetOptions($hash, @_);
    } else {
        $res = Getopt::Long::GetOptions(@_);
    }
    Getopt::Long::Configure($old_conf);
    $res;
}

sub GetOptions {
    GetOptionsWithCompletion(undef, @_);
}

1;
# ABSTRACT: A drop-in replacement for Getopt::Long, with shell tab completion

__END__