view release on metacpan or  search on metacpan

script/cdpart-backend  view on Meta::CPAN

#!perl

use 5.010001;
use strict;
use warnings;

use Complete::Util qw(complete_array_elem hashify_answer);
use Cwd qw(cwd);
use File::chdir;
use Getopt::Long::Complete qw(GetOptionsWithCompletion);

our $AUTHORITY = 'cpan:PERLANCAR'; # AUTHORITY
our $DATE = '2026-04-07'; # DATE
our $DIST = 'App-CdUtils'; # DIST
our $VERSION = '0.015'; # VERSION

# FRAGMENT id=shcompgen-hint completer=1 for=cdpart

our $DEBUG = $ENV{DEBUG};
our $COMPLETE_MAX_ENTRIES_PER_LEVEL = $ENV{CDPART_COMPLETE_MAX_ENTRIES_PER_LEVEL} // 100;

my $cwd = $ENV{PWD} || cwd();
my @cwd_elems = split m!/+!, $cwd;

GetOptionsWithCompletion(
    sub {
        my %args = @_;
        my $type = $args{type};
        my $word = $args{word};

        return undef unless $type eq 'arg'; ## no critic: Subroutines::ProhibitExplicitReturnUndef
        my @res;

        #for (reverse 1 .. $#cwd_elems) {
        #    push @res0, {
        #        word => $cwd_elems[$_],
        #        summary => join("/", @cwd_elems[0 .. $_]),
        #    };
        #}

        local $Complete::Common::OPT_CHAR_MODE = 0 unless defined $ENV{COMPLETE_OPT_CHAR_MODE};
        local $Complete::Common::OPT_FUZZY = 0 unless defined $ENV{COMPLETE_OPT_FUZZY};

        while (1) {
            #last if @res >= $COMPLETE_MAX_ENTRIES;
            pop @cwd_elems;
            $CWD = "..";
            last unless @cwd_elems >= 1;
            my $entry;
            opendir my $dh, ".";
            my @dirs =grep { $_ ne '.' && $_ ne '..' && (-d $_) } readdir($dh);
            closedir $dh;
            my $level_res = complete_array_elem(word => $word, array => \@dirs);
            #use DD; dd $level_res;
            for (@{ $level_res }) {
                push @res, {
                    word => $_,
                    summary => join("/", @cwd_elems, $_),
                }
            }
        }
        \@res;
    },
    'help|h' => sub {
        print <<USAGE;
Usage:
  % cdpart [options] <dirname>
Options:
  --help, -h
  --version, -v
USAGE
        exit 0;
    },
    'version|v' => sub {
        no warnings 'once';
        print "cdpart version ", ($main::VERSION || "dev"), "\n";
        exit 0;
    },
);

if (@ARGV != 1) { print ".\n"; exit }

while (@cwd_elems >= 1) {