view release on metacpan or  search on metacpan

lib/App/short.pm  view on Meta::CPAN

    my $word    = $args{word} // '';
    my $cmdline = $args{cmdline};
    my $r       = $args{r};

    return undef unless $cmdline;

    $r->{read_config} = 1;
    my $res = $cmdline->parse_argv($r);
    return undef unless $res->[0] == 200;

    my $fargs = $res->[2];

    $res = _validate($fargs);
    return undef unless $res->[0] == 200;

    $res = list_missing(_common_args($fargs));
    return undef unless $res->[0] == 200;

    Complete::Util::complete_array_elem(
        array=>$res->[2], word=>$word,
    );
};

my $_completion_short = sub {
    unless (PRELOAD) { require Complete::Util; } #PRELOAD
    my %args = @_;
    my $word    = $args{word} // '';
    my $cmdline = $args{cmdline};
    my $r       = $args{r};

    return undef unless $cmdline;

    $r->{read_config} = 1;
    my $res = $cmdline->parse_argv($r);
    return undef unless $res->[0] == 200;

    my $fargs = $res->[2];

    $res = _validate($fargs);
    return undef unless $res->[0] == 200;

    $res = list_shorts(_common_args($fargs));
    return undef unless $res->[0] == 200;

    Complete::Util::complete_array_elem(
        array=>$res->[2], word=>$word,
    );
};

# (temporary) borrowed from PERLANCAR::Path::Util
sub _get_my_home_dir {
    if ($^O eq 'Win32') {
        # File::HomeDir always uses exists($ENV{x}) first, does it want to avoid
        # accidentally creating env vars?
        return $ENV{HOME} if $ENV{HOME};
        return $ENV{USERPROFILE} if $ENV{USERPROFILE};
        return join($ENV{HOMEDRIVE}, "\\", $ENV{HOMEPATH})
            if $ENV{HOMEDRIVE} && $ENV{HOMEPATH};
    } else {
        return $ENV{HOME} if $ENV{HOME};
        my @pw = getpwuid($>);
        return $pw[7] if @pw;
    }
    undef;
}

sub _common_args {
    my $args = shift;
    my %res;
    for (keys %common_args) {
        $res{$_} = $args->{$_} if exists $args->{$_};
    }
    %res;
}

sub _validate {
    my $args = shift;
    return [200] if $args->{-validated};

    if (defined $args->{long}) {
        return [400, "Invalid long name"] if $args->{long} =~ m![/\\]!;
    }
    if (defined $args->{short}) {
        my @shorts = ref($args->{short}) eq 'ARRAY' ?
            @{$args->{short}} : ($args->{short});
        for (@shorts) {
            return [400, "Invalid short name '$_'"] if m![/\\]!;
        }
    }

    $args->{-validated}++;
    [200];
}

$SPEC{':package'} = {
    v => 1.1,
    summary => 'Manage short directory symlinks',
};

$SPEC{list_shorts} = {
    v => 1.1,
    args => {
        %common_args,
        %detail_l_arg,
        broken => {
            schema => 'bool',
            tags => ['category:filtering'],
        },
        query => {
            schema => 'str*',
            tags => ['category:filtering'],
            pos => 0,
        },
    },
};
sub list_shorts {
    my %args = @_;
    my $res = _validate(\%args);
    return $res unless $res->[0] == 200;

    my $S = $args{short_dir};