view release on metacpan or  search on metacpan

script/_pick-random-lines  view on Meta::CPAN

#        dep_all => [recurse_matching => ['recurse']],
#    },
#    result_naked => 1,
#    result => {
#        schema => 'array',
#    },
#};
#sub complete_file {
#    require Complete::Path;
#    require Encode;
#    require File::Glob;
#
#    my %args   = @_;
#    my $word   = $args{word} // "";
#    my $handle_tilde = $args{handle_tilde} // 1;
#    my $allow_dot   = $args{allow_dot} // 1;
#
#    # if word is starts with "~/" or "~foo/" replace it temporarily with user's
#    # name (so we can restore it back at the end). this is to mimic bash
#    # support. note that bash does not support case-insensitivity for "foo".
#    my $result_prefix;
#    my $starting_path = $args{starting_path} // '.';
#    if ($handle_tilde && $word =~ s!\A(~[^/]*)/!!) {
#        $result_prefix = "$1/";
#        my @dir = File::Glob::bsd_glob($1); # glob will expand ~foo to /home/foo
#        return [] unless @dir;
#        $starting_path = Encode::decode('UTF-8', $dir[0]);
#    } elsif ($allow_dot && $word =~ s!\A((?:\.\.?/+)+|/+)!!) {
#        # just an optimization to skip sequences of '../'
#        $starting_path = $1;
#        $result_prefix = $1;
#        $starting_path =~ s#/+\z## unless $starting_path =~ m!\A/!;
#    }
#
#    # bail if we don't allow dot and the path contains dot
#    return [] if !$allow_dot &&
#        $word =~ m!(?:\A|/)\.\.?(?:\z|/)!;
#
#    # prepare list_func
#    my $list = sub {
#        my ($path, $intdir, $isint) = @_;
#        opendir my($dh), $path or return undef;
#        my @res;
#        for (sort readdir $dh) {
#            # skip . and .. if leaf is empty, like in bash
#            next if ($_ eq '.' || $_ eq '..') && $intdir eq '';
#            next if $isint && !(-d "$path/$_");
#            push @res, Encode::decode('UTF-8', $_);
#        }
#        \@res;
#    };
#
#    # prepare filter_func
#
#    # from the filter option
#    my $filter;
#    if ($args{filter} && !ref($args{filter})) {
#        my @seqs = split /\s*\|\s*/, $args{filter};
#        $filter = sub {
#            my $name = shift;
#            my @st = stat($name) or return 0;
#            my $mode = $st[2];
#            my $pass;
#          SEQ:
#            for my $seq (@seqs) {
#                my $neg = sub { $_[0] };
#                for my $c (split //, $seq) {
#                    if    ($c eq '-') { $neg = sub { $_[0] ? 0 : 1 } }
#                    elsif ($c eq 'r') { next SEQ unless $neg->($mode & 0400) }
#                    elsif ($c eq 'w') { next SEQ unless $neg->($mode & 0200) }
#                    elsif ($c eq 'x') { next SEQ unless $neg->($mode & 0100) }
#                    elsif ($c eq 'f') { next SEQ unless $neg->($mode & 0100000)}
#                    elsif ($c eq 'd') { next SEQ unless $neg->($mode & 0040000)}
#                    else {
#                        die "Unknown character in filter: $c (in $seq)";
#                    }
#                }
#                $pass = 1; last SEQ;
#            }
#            $pass;
#        };
#    } elsif ($args{filter} && ref($args{filter}) eq 'CODE') {
#        $filter = $args{filter};
#    }
#
#    # from the file_regex_filter option
#    my $filter_fregex;
#    if ($args{file_regex_filter}) {
#        $filter_fregex = sub {
#            my $name = shift;
#            return 1 if -d $name;
#            return 0 unless -f _;
#            return 1 if $name =~ $args{file_regex_filter};
#            0;
#        };
#    }
#
#    # from the file_ext_filter option
#    my $filter_fext;
#    if ($args{file_ext_filter} && ref $args{file_ext_filter} eq 'Regexp') {
#        $filter_fext = sub {
#            my $name = shift;
#            return 1 if -d $name;
#            return 0 unless -f _;
#            my $ext = $name =~ /\.(\w+)\z/ ? $1 : '';
#            return 1 if $ext =~ $args{file_ext_filter};
#            0;
#        };
#    } elsif ($args{file_ext_filter} && ref $args{file_ext_filter} eq 'ARRAY') {
#        $filter_fext = sub {
#            my $name = shift;
#            return 1 if -d $name;
#            return 0 unless -f _;
#            my $ext = $name =~ /\.(\w+)\z/ ? $1 : '';
#            if ($Complete::Common::OPT_CI) {
#                $ext = lc($ext);
#                for my $e (@{ $args{file_ext_filter} }) {
#                    return 1 if $ext eq lc($e);
#                }
#            } else {
#                for my $e (@{ $args{file_ext_filter} }) {