App-ppgrep

 view release on metacpan or  search on metacpan

script/_ppgrep  view on Meta::CPAN

#
#Command line arguments, like @ARGV.
#
#See function C<parse_cmdline> in L<Complete::Bash> on how to produce this (if
#you're using bash).
#
#=back
#
#Return value:  (hash|array)
#
#
#You can use C<format_completion> function in L<Complete::Bash> module to format
#the result of this function for bash.
#
#=head1 HOMEPAGE
#
#Please visit the project's homepage at L<https://metacpan.org/release/Complete-Getopt-Long>.
#
#=head1 SOURCE
#
#Source repository is at L<https://github.com/perlancar/perl-Complete-Getopt-Long>.
#
#=head1 BUGS
#
#Please report any bugs or feature requests on the bugtracker website L<https://rt.cpan.org/Public/Dist/Display.html?Name=Complete-Getopt-Long>
#
#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<Getopt::Long::Complete>
#
#L<Complete>
#
#L<Complete::Bash>
#
#Other modules related to bash shell tab completion: L<Bash::Completion>,
#L<Getopt::Complete>.
#
#L<Perinci::CmdLine> - an alternative way to easily create command-line
#applications with completion feature.
#
#=head1 AUTHOR
#
#perlancar <perlancar@cpan.org>
#
#=head1 COPYRIGHT AND LICENSE
#
#This software is copyright (c) 2019, 2017, 2016, 2015, 2014 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
### Complete/Path.pm ###
#package Complete::Path;
#
#our $DATE = '2017-07-03'; # DATE
#our $VERSION = '0.24'; # VERSION
#
#use 5.010001;
#use strict;
#use warnings;
#
#use Complete::Common qw(:all);
#
#our $COMPLETE_PATH_TRACE = $ENV{COMPLETE_PATH_TRACE} // 0;
#
#require Exporter;
#our @ISA = qw(Exporter);
#our @EXPORT_OK = qw(
#                       complete_path
#               );
#
#sub _dig_leaf {
#    my ($p, $list_func, $is_dir_func, $filter_func, $path_sep) = @_;
#    my $num_dirs;
#    my $listres = $list_func->($p, '', 0);
#    return $p unless ref($listres) eq 'ARRAY' && @$listres;
#    my @candidates;
#  L1:
#    for my $e (@$listres) {
#        my $p2 = $p =~ m!\Q$path_sep\E\z! ? "$p$e" : "$p$path_sep$e";
#        {
#            local $_ = $p2; # convenience for filter func
#            next L1 if $filter_func && !$filter_func->($p2);
#        }
#        push @candidates, $p2;
#    }
#    return $p unless @candidates == 1;
#    my $p2 = $candidates[0];
#    my $is_dir;
#    if ($p2 =~ m!\Q$path_sep\E\z!) {
#        $is_dir++;
#    } else {
#        $is_dir = $is_dir_func && $is_dir_func->($p2);
#    }
#    return _dig_leaf($p2, $list_func, $is_dir_func, $filter_func, $path_sep)
#        if $is_dir;
#    $p2;
#}
#
#our %SPEC;
#
#$SPEC{complete_path} = {
#    v => 1.1,
#    summary => 'Complete path',
#    description => <<'_',
#
#Complete path, for anything path-like. Meant to be used as backend for other
#functions like `Complete::File::complete_file` or
#`Complete::Module::complete_module`. Provides features like case-insensitive
#matching, expanding intermediate paths, and case mapping.
#
#Algorithm is to split path into path elements, then list items (using the
#supplied `list_func`) and perform filtering (using the supplied `filter_func`)
#at every level.
#
#_

script/_ppgrep  view on Meta::CPAN

#                "$dir$e" : "$dir$path_sep$e";
#            #say "D:p=$p";
#            {
#                local $_ = $p; # convenience for filter func
#                next L1 if $filter_func && !$filter_func->($p);
#            }
#
#            my $is_dir;
#            if ($e =~ $re_ends_with_path_sep) {
#                $is_dir = 1;
#            } else {
#                local $_ = $p; # convenience for is_dir_func
#                $is_dir = $is_dir_func->($p);
#            }
#
#            if ($is_dir && $dig_leaf) {
#                {
#                    my $p2 = _dig_leaf($p, $list_func, $is_dir_func, $filter_func, $path_sep);
#                    last if $p2 eq $p;
#                    $p = $p2;
#                    #say "D:p=$p (dig_leaf)";
#
#                    # check again
#                    if ($p =~ $re_ends_with_path_sep) {
#                        $is_dir = 1;
#                    } else {
#                        local $_ = $p; # convenience for is_dir_func
#                        $is_dir = $is_dir_func->($p);
#                    }
#                }
#            }
#
#            # process into final result
#            my $p0 = $p;
#            substr($p, 0, $cut_chars) = '' if $cut_chars;
#            $p = "$result_prefix$p" if length($result_prefix);
#            unless ($p =~ /\Q$path_sep\E\z/) {
#                $p .= $path_sep if $is_dir;
#            }
#            push @res, $p;
#        }
#    }
#
#    \@res;
#}
#1;
## ABSTRACT: Complete path
#
#__END__
#
#=pod
#
#=encoding UTF-8
#
#=head1 NAME
#
#Complete::Path - Complete path
#
#=head1 VERSION
#
#This document describes version 0.24 of Complete::Path (from Perl distribution Complete-Path), released on 2017-07-03.
#
#=head1 DESCRIPTION
#
#=head1 FUNCTIONS
#
#
#=head2 complete_path
#
#Usage:
#
# complete_path(%args) -> array
#
#Complete path.
#
#Complete path, for anything path-like. Meant to be used as backend for other
#functions like C<Complete::File::complete_file> or
#C<Complete::Module::complete_module>. Provides features like case-insensitive
#matching, expanding intermediate paths, and case mapping.
#
#Algorithm is to split path into path elements, then list items (using the
#supplied C<list_func>) and perform filtering (using the supplied C<filter_func>)
#at every level.
#
#This function is not exported by default, but exportable.
#
#Arguments ('*' denotes required arguments):
#
#=over 4
#
#=item * B<filter_func> => I<code>
#
#Provide extra filtering. Code will be given path and should return 1 if the item
#should be included in the final result or 0 if the item should be excluded.
#
#=item * B<is_dir_func> => I<code>
#
#Function to check whether a path is a "dir".
#
#Optional. You can provide this function to determine if an item is a "directory"
#(so its name can be suffixed with path separator). You do not need to do this if
#you already suffix names of "directories" with path separator in C<list_func>.
#
#One reason you might want to provide this and not mark "directories" in
#C<list_func> is when you want to do extra filtering with C<filter_func>. Sometimes
#you do not want to suffix the names first (example: see C<complete_file> in
#C<Complete::File>).
#
#=item * B<list_func>* => I<code>
#
#Function to list the content of intermediate "dirs".
#
#Code will be called with arguments: ($path, $cur_path_elem, $is_intermediate).
#Code should return an arrayref containing list of elements. "Directories" can be
#marked by ending the name with the path separator (see C<path_sep>). Or, you can
#also provide an C<is_dir_func> function that will be consulted after filtering.
#If an item is a "directory" then its name will be suffixed with a path
#separator by C<complete_path()>.
#
#=item * B<path_sep> => I<str> (default: "/")
#

script/_ppgrep  view on Meta::CPAN

#    $tree->find( $finder_subs{$_} )
#      for qw( del_superfluous_concat del_last_semicolon_in_block separate_version shorten_var_names shorten_barewords );
#    die $@ if $@;
#
#    for my $name ( 'double_semicolon' ) {
#        my $elements = $tree->find( $finder_subs{$name} );
#        die $@ if !defined $elements;
#        $_->delete for @{ $elements || [] };
#    }
#
#    return $tree->serialize . "\n";
#}
#
#sub tok { "PPI::Token::$_[0]" }
#
#sub _finder_subs {
#    return (
#        comments => sub { $_[1]->isa( tok 'Comment' ) },
#
#        duplicate_whitespace => sub {
#            my ( $top, $current ) = @_;
#            return 0 if !$current->isa( tok 'Whitespace' );
#
#            $current->set_content(' ') if 1 < length $current->content;
#
#            return 0 if !$current->next_token;
#            return 0 if !$current->next_token->isa( tok 'Whitespace' );
#            return 1;
#        },
#
#        whitespace => sub {
#            my ( $top, $current ) = @_;
#            return 0 if !$current->isa( tok 'Whitespace' );
#            my $prev = $current->previous_token;
#            my $next = $current->next_token;
#
#            return 1 if $prev->isa( tok 'Number' ) and $next->isa( tok 'Operator' ) and $next->content =~ /^\W/; # my $P
#            return 1 if $prev->isa( tok 'Word' )   and $next->isa( tok 'Operator' ) and $next->content =~ /^\W/; # my $P
#            return 1 if $prev->isa( tok 'Symbol' ) and $next->isa( tok 'Operator' ) and $next->content =~ /^\W/; # $VERSION =  but not $v and
#
#            return 1 if $prev->isa( tok 'Operator' ) and $next->isa( tok 'Quote::Single' ) and $next->content =~ /^\W/; # eq ''
#            return 1 if $prev->isa( tok 'Operator' ) and $next->isa( tok 'Quote::Double' ) and $next->content =~ /^\W/; # eq ""
#            return 1 if $prev->isa( tok 'Operator' ) and $next->isa( tok 'Symbol' )        and $next->content =~ /^\W/; # eq $v
#            return 1 if $prev->isa( tok 'Operator' ) and $next->isa( tok 'Structure' )     and $next->content =~ /^\W/; # eq (
#
#            return 1 if $prev->isa( tok 'Word' )       and $next->isa( tok 'Symbol' );           # my $P
#            return 1 if $prev->isa( tok 'Word' )       and $next->isa( tok 'Structure' );        # sub {
#            return 1 if $prev->isa( tok 'Word' )       and $next->isa( tok 'Quote::Double' );    # eval "
#            return 1 if $prev->isa( tok 'Symbol' )     and $next->isa( tok 'Structure' );        # %a )
#            return 1 if $prev->isa( tok 'ArrayIndex' ) and $next->isa( tok 'Operator' );         # $#_ ?
#            return 1 if $prev->isa( tok 'Word' )       and $next->isa( tok 'Cast' );             # exists &$_
#            return 0;
#        },
#
#        trailing_whitespace => sub {
#            my ( $top, $current ) = @_;
#            return 0 if !$current->isa( tok 'Whitespace' );
#            my $prev = $current->previous_token;
#
#            return 1 if $prev->isa( tok 'Structure' );                                           # ;[\n\s]
#            return 1 if $prev->isa( tok 'Operator' ) and $prev->content =~ /\W$/;                # = 0.24
#            return 1 if $prev->isa( tok 'Quote::Double' );                                       # " .
#            return 1 if $prev->isa( tok 'Quote::Single' );                                       # ' }
#
#            return 0;
#        },
#
#        double_semicolon => sub {
#            my ( $top, $current ) = @_;
#            return 0 if !$current->isa( tok 'Structure' );
#            return 0 if $current->content ne ';';
#
#            my $prev = $current->previous_token;
#
#            return 0 if !$prev->isa( tok 'Structure' );
#            return 0 if $prev->content ne ';';
#
#            return 1;
#        },
#
#        del_last_semicolon_in_block => sub {
#            my ( $top, $current ) = @_;
#            return 0 if !$current->isa( 'PPI::Structure::Block' );
#
#            my $last = $current->last_token;
#
#            return 0 if !$last->isa( tok 'Structure' );
#            return 0 if $last->content ne '}';
#
#            my $maybe_semi = $last->previous_token;
#
#            return 0 if !$maybe_semi->isa( tok 'Structure' );
#            return 0 if $maybe_semi->content ne ';';
#
#            $maybe_semi->delete;
#
#            return 1;
#        },
#
#        del_superfluous_concat => sub {
#            my ( $top, $current ) = @_;
#            return 0 if !$current->isa( tok 'Operator' );
#
#            my $prev = $current->previous_token;
#            my $next = $current->next_token;
#
#            return 0 if $current->content ne '.';
#            return 0 if !$prev->isa( tok 'Quote::Double' );
#            return 0 if !$next->isa( tok 'Quote::Double' );
#
#            $current->delete;
#            $prev->set_content( $prev->{separator} . $prev->string . $next->string . $prev->{separator} );
#            $next->delete;
#
#            return 1;
#        },
#
#        separate_version => sub {
#            my ( $top, $current ) = @_;
#            return 0 if !$current->isa( 'PPI::Statement' );
#



( run in 2.021 seconds using v1.01-cache-2.11-cpan-39bf76dae61 )