File Coverage

blib/lib/Complete/File.pm

Criterion	Covered	Total	%
statement	110	125	88.0
branch	76	106	71.7
condition	28	41	68.2
subroutine	16	16	100.0
pod	2	2	100.0
total	232	290	80.0

package Complete::File;

our $DATE = '2021-02-08'; # DATE
our $VERSION = '0.443'; # VERSION

use 5.010001;
use strict;
use warnings;

use Complete::Common qw(:all);
use Complete::Util qw(hashify_answer);

require Exporter;
our @ISA = qw(Exporter);
our @EXPORT_OK = qw(
                       complete_file
                       complete_dir
               );

our %SPEC;

$SPEC{':package'} = {
    v => 1.1,
    summary => 'Completion routines related to files',
};

$SPEC{complete_file} = {
    v => 1.1,
    summary => 'Complete file and directory from local filesystem',
    args => {
        %arg_word,
        filter => {
            summary => 'Only return items matching this filter',
            description => <<'_',

Filter can either be a string or a code.

For string filter, you can specify a pipe-separated groups of sequences of these
characters: f, d, r, w, x. Dash can appear anywhere in the sequence to mean
not/negate. An example: `f` means to only show regular files, `-f` means only
show non-regular files, `drwx` means to show only directories which are
readable, writable, and executable (cd-able). `wf|wd` means writable regular
files or writable directories.

For code filter, you supply a coderef. The coderef will be called for each item
with these arguments: `$name`. It should return true if it wants the item to be
included.

_
            schema  => ['any*' => {of => ['str*', 'code*']}],
            tags => ['category:filtering'],
        },
        file_regex_filter => {
            summary => 'Filter shortcut for file regex',
            description => <<'_',

This is a shortcut for constructing a filter. So instead of using `filter`, you
use this option. This will construct a filter of including only directories or
regular files, and the file must match a regex pattern. This use-case is common.

_
            schema => 're*',
            tags => ['category:filtering'],
        },
        exclude_dir => {
            schema => 'bool*',
            description => <<'_',

This is also an alternative to specifying full `filter`. Set this to true if you
do not want directories.

If you only want directories, take a look at `complete_dir()`.

_
            tags => ['category:filtering'],
        },
        file_ext_filter => {
            schema => ['any*', of=>['re*', ['array*',of=>'str*']]],
            description => <<'_',

This is also an alternative to specifying full `filter` or `file_regex_filter`.
You can set this to a regex or a set of extensions to accept. Note that like in
`file_regex_filter`, directories of any name is also still allowed.

_
            tags => ['category:filtering'],
        },
        starting_path => {
            schema  => 'str*',
            default => '.',
        },
        handle_tilde => {
            schema  => 'bool',
            default => 1,
        },
        allow_dot => {
            summary => 'If turned off, will not allow "." or ".." in path',
            description => <<'_',

This is most useful when combined with `starting_path` option to prevent user
going up/outside the starting path.

_
            schema  => 'bool',
            default => 1,
        },
        recurse => {
            schema => 'bool*',
            cmdline_aliases => {r=>{}},
        },
        recurse_matching => {
            schema => ['str*', in=>['level-by-level', 'all-at-once']],
            default => 'level-by-level',
        },
        exclude_leaf => {
            schema => 'bool*',
        },
        exclude_dir => {
            schema => 'bool*',
        },
    },
    args_rels => {
        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} }) {
                    return 1 if $ext eq $e;
                }
            }
            0;
        };
    }

    # from _dir (used by complete_dir)
    my $filter_dir;
    if ($args{_dir}) {
        $filter_dir = sub { return 0 unless (-d $_[0]); 1 };
    }

    # from exclude_dir option
    my $filter_xdir;
    if ($args{exclude_dir}) {
        $filter_xdir = sub { return 0 if (-d $_[0]); 1 };
    }

    # final filter sub
    my $final_filter = sub {
        my $name = shift;
        if ($filter_dir)    { return 0 unless $filter_dir->($name)    }
        if ($filter_xdir)   { return 0 unless $filter_xdir->($name)   }
        if ($filter)        { return 0 unless $filter->($name)        }
        if ($filter_fregex) { return 0 unless $filter_fregex->($name) }
        if ($filter_fext)   { return 0 unless $filter_fext->($name)   }
        1;
    };

    my $compres = Complete::Path::complete_path(
        word => $word,
        list_func => $list,
        is_dir_func => sub { -d $_[0] },
        filter_func => $final_filter,
        starting_path => $starting_path,
        result_prefix => $result_prefix,
        recurse => $args{recurse},
        recurse_matching => $args{recurse_matching},
        exclude_leaf => $args{exclude_leaf},
        exclude_nonleaf => $args{exclude_nonleaf} // $args{exclude_dir},
    );

    # XXX why doesn't Complete::Path return hash answer with path_sep? we add
    # workaround here to enable path mode.
    hashify_answer($compres, {path_sep=>'/'});
}

$SPEC{complete_dir} = do {
    my $spec = {%{ $SPEC{complete_file} }}; # shallow copy

    $spec->{summary} = 'Complete directory from local filesystem '.
        '(wrapper for complete_dir() that only picks directories)';
    $spec->{args} = { %{$spec->{args}} }; # shallow copy of args
    delete $spec->{args}{file_regex_filter};
    delete $spec->{args}{file_ext_filter};
    delete $spec->{args}{exclude_dir};

    $spec;
};
sub complete_dir {
    my %args = @_;

    complete_file(%args, _dir=>1);
}

1;
# ABSTRACT: Completion routines related to files

__END__