view release on metacpan or  search on metacpan

script/testcomp  view on Meta::CPAN

#!perl

use 5.010;
use strict;
use warnings;
use Log::ger;

BEGIN { $ENV{TRACE} = 1 }

use File::Which qw(which);
use Getopt::Long;
use Log::ger::Level::FromEnv;
use Log::ger::Output Screen => (colorize_tags=>1);

our $AUTHORITY = 'cpan:PERLANCAR'; # AUTHORITY
our $DATE = '2022-01-16'; # DATE
our $DIST = 'App-CompleteUtils'; # DIST
our $VERSION = '0.180'; # VERSION

sub _shell_quote_arg {
    require String::ShellQuote;
    # pass some strings unquoted: foo=bar is quoted into 'foo=bar' by
    # String::ShellQuote; skip quoting it
    #say "D:<$_[0]>";
    if ($_[0] =~ /\A[A-Za-z0-9_=^-]+\z/) {
        return $_[0];
    } else {
        return String::ShellQuote::shell_quote($_[0]);
    }
}

my %Opts = (
    shell => undef,
);

my @inc;
Getopt::Long::Configure(
    'no_ignore_case', 'bundling', 'no_permute', 'pass_through',
    'auto_help', 'auto_version');
GetOptions(
    'include|I=s' => sub {
        unshift @inc, $_[1];
    },
    'shell|s=s' => \$Opts{shell},
    'bash' => sub { $Opts{shell} = 'bash' },
    'tcsh' => sub { $Opts{shell} = 'tcsh' },
    'fish' => sub { $Opts{shell} = 'fish' },
    'zsh'  => sub { $Opts{shell} = 'zsh'  },
);

@ARGV or die "testcomp: Please specify script to run as first argument\n";
my $script = shift @ARGV;
if (!(-f $script) && $script !~ m!/!) {
    my $script_p = which($script)
        or die "testcomp: Script '$script' not found in PATH\n";
    $script = $script_p;
}

unless ($Opts{shell}) {
    require Shell::Guess;
    my $shell = Shell::Guess->running_shell;
    $shell = "tcsh" if $shell eq 'c';
    $shell = "zsh"  if $shell eq 'z';
    $Opts{shell} = $shell;
}

my $comp_line = "$script ";
if (@ARGV == 1 && $ARGV[0] =~ /\s/) {
    # user types: scriptname 'arg1 arg2 ...'. we should split the quoted args
    $comp_line .= join(" ", @ARGV);
} else {
    # user types: scriptname 'arg1' 'arg two'. we should re-quote to avoid the
    # space inside arg value to split args.
    $comp_line .= join(" ", map {_shell_quote_arg($_)} @ARGV);
}

my $comp_point;
if ($comp_line =~ /\^/) {
    $comp_point = index($comp_line, '^');
    $comp_line =~ s/\^//;
} else {
    $comp_point = length($comp_line);
}