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__

=pod

=encoding UTF-8

=head1 NAME

Complete::File - Completion routines related to files

=head1 VERSION

This document describes version 0.443 of Complete::File (from Perl distribution Complete-File), released on 2021-02-08.

=head1 DESCRIPTION

=head1 FUNCTIONS


=head2 complete_dir

Usage:

 complete_dir(%args) -> array

Complete directory from local filesystem (wrapper for complete_dir() that only picks directories).

This function is not exported by default, but exportable.

Arguments ('*' denotes required arguments):

=over 4

=item * B<allow_dot> => I<bool> (default: 1)

If turned off, will not allow "." or ".." in path.

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

=item * B<exclude_leaf> => I<bool>

=item * B<filter> => I<str|code>

Only return items matching this filter.

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: C<f> means to only show regular files, C<-f> means only
show non-regular files, C<drwx> means to show only directories which are
readable, writable, and executable (cd-able). C<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: C<$name>. It should return true if it wants the item to be
included.

=item * B<handle_tilde> => I<bool> (default: 1)

=item * B<recurse> => I<bool>

=item * B<recurse_matching> => I<str> (default: "level-by-level")

=item * B<starting_path> => I<str> (default: ".")

=item * B<word>* => I<str> (default: "")

Word to complete.


=back

Return value:  (array)



=head2 complete_file

Usage:

 complete_file(%args) -> array

Complete file and directory from local filesystem.

This function is not exported by default, but exportable.

Arguments ('*' denotes required arguments):

=over 4

=item * B<allow_dot> => I<bool> (default: 1)

If turned off, will not allow "." or ".." in path.

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

=item * B<exclude_dir> => I<bool>

=item * B<exclude_leaf> => I<bool>

=item * B<file_ext_filter> => I<re|array[str]>

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

=item * B<file_regex_filter> => I<re>

Filter shortcut for file regex.

This is a shortcut for constructing a filter. So instead of using C<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.

=item * B<filter> => I<str|code>

Only return items matching this filter.

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: C<f> means to only show regular files, C<-f> means only
show non-regular files, C<drwx> means to show only directories which are
readable, writable, and executable (cd-able). C<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: C<$name>. It should return true if it wants the item to be
included.

=item * B<handle_tilde> => I<bool> (default: 1)

=item * B<recurse> => I<bool>

=item * B<recurse_matching> => I<str> (default: "level-by-level")

=item * B<starting_path> => I<str> (default: ".")

=item * B<word>* => I<str> (default: "")

Word to complete.


=back

Return value:  (array)

=head1 HOMEPAGE

Please visit the project's homepage at L<https://metacpan.org/release/Complete-File>.

=head1 SOURCE

Source repository is at L<https://github.com/perlancar/perl-Complete-File>.

=head1 BUGS

Please report any bugs or feature requests on the bugtracker website L<https://github.com/perlancar/perl-Complete-File/issues>

When submitting a bug or request, please include a test-file or a
patch to an existing test-file that illustrates the bug or desired
feature.

=head1 SEE ALSO

L<Complete>

Other C<Complete::*> modules.

=head1 AUTHOR

perlancar <perlancar@cpan.org>

=head1 COPYRIGHT AND LICENSE

This software is copyright (c) 2021, 2019, 2017, 2016, 2015 by perlancar@cpan.org.

This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.

=cut