Commit | Line | Data |
1716b200 |
1 | use strict; |
2 | use warnings; |
f1f5a418 |
3 | package Devel::REPL::Plugin::CompletionDriver::INC; |
9d2a4940 |
4 | # ABSTRACT: Complete module names in use and require |
6f4f9516 |
5 | |
77327851 |
6 | our $VERSION = '1.003030'; |
54beb05d |
7 | |
f1f5a418 |
8 | use Devel::REPL::Plugin; |
b1c83802 |
9 | use Devel::REPL::Plugin::Completion; # die early if cannot load |
f1f5a418 |
10 | use File::Next; |
11 | use File::Spec; |
aa8b7647 |
12 | use namespace::autoclean; |
f1f5a418 |
13 | |
3a400715 |
14 | sub BEFORE_PLUGIN { |
15 | my $self = shift; |
16 | $self->load_plugin('Completion'); |
17 | } |
6631e15c |
18 | |
f1f5a418 |
19 | around complete => sub { |
20 | my $orig = shift; |
21 | my ($self, $text, $document) = @_; |
22 | |
23 | my $last = $self->last_ppi_element($document, 'PPI::Statement::Include'); |
24 | |
25 | return $orig->(@_) |
26 | unless $last->isa('PPI::Statement::Include'); |
27 | |
28 | my @elements = $last->children; |
29 | shift @elements; # use or require |
30 | |
31 | # too late for us to care, they're completing on something like |
32 | # use List::Util qw(m |
33 | # OR they just have "use " and are tab completing. we'll spare them the flood |
34 | return $orig->(@_) |
35 | if @elements != 1; |
36 | |
37 | my $package = shift @elements; |
38 | my $outsep = '::'; |
c5cdacc2 |
39 | my $insep = "::"; |
f1f5a418 |
40 | my $keep_extension = 0; |
c5cdacc2 |
41 | my $prefix = ''; |
42 | |
43 | # require "Foo/Bar.pm" -- not supported yet, ->string doesn't work for |
44 | # partially completed elements |
45 | #if ($package->isa('PPI::Token::Quote')) |
46 | #{ |
47 | # # we need to strip off the leading quote and stash it |
48 | # $package = $package->string; |
49 | # my $start = index($package->quote, $package); |
50 | # $prefix = substr($package->quote, 0, $start); |
51 | |
52 | # # we're completing something like: require "Foo/Bar.pm" |
53 | # $outsep = $insep = '/'; |
54 | # $keep_extension = 1; |
55 | #} |
56 | if ($package =~ /'/) |
f1f5a418 |
57 | { |
b0489a7c |
58 | # the goofball is using the ancient ' package sep, we'll humor him |
c5cdacc2 |
59 | $outsep = "'"; |
b0489a7c |
60 | $insep = "'|::"; |
f1f5a418 |
61 | } |
62 | |
63 | my @directories = split $insep, $package; |
64 | |
65 | # split drops trailing fields |
66 | push @directories, '' if $package =~ /(?:$insep)$/; |
67 | my $final = pop @directories; |
68 | my $final_re = qr/^\Q$final/; |
69 | |
70 | my @found; |
71 | |
16d29e42 |
72 | # most VCSes don't litter every single fucking directory with garbage. if you |
0e0d2539 |
73 | # know of any other, just stick them in here. No one wants to complete |
16d29e42 |
74 | # Devel::REPL::Plugin::.svn |
c5cdacc2 |
75 | my %ignored = |
76 | ( |
77 | '.' => 1, |
78 | '..' => 1, |
79 | '.svn' => 1, |
80 | ); |
81 | |
16d29e42 |
82 | # this will take a directory and add to @found all of the possible matches |
6c3218fe |
83 | my $add_recursively; |
84 | $add_recursively = sub { |
85 | my ($path, $iteration, @more) = @_; |
ce00c3c0 |
86 | opendir((my $dirhandle), $path) || return; |
c5cdacc2 |
87 | for (grep { !$ignored{$_} } readdir $dirhandle) |
6c3218fe |
88 | { |
6c3218fe |
89 | my $match = $_; |
c5cdacc2 |
90 | |
91 | # if this is the first time around, we need respect whatever the user had |
92 | # at the very end when he pressed tab |
93 | next if $iteration == 0 && $match !~ $final_re; |
94 | |
6c3218fe |
95 | my $fullmatch = File::Spec->rel2abs($match, $path); |
96 | if (-d $fullmatch) |
97 | { |
98 | $add_recursively->($fullmatch, $iteration + 1, @more, $match); |
99 | } |
100 | else |
101 | { |
102 | $match =~ s/\..*// unless $keep_extension; |
c5cdacc2 |
103 | push @found, join '', $prefix, |
104 | join $outsep, @directories, @more, $match; |
6c3218fe |
105 | } |
106 | } |
107 | }; |
108 | |
afc8677b |
109 | # look through all of |
f1f5a418 |
110 | INC: for (@INC) |
111 | { |
112 | my $path = $_; |
16d29e42 |
113 | |
114 | # match all of the fragments they have, so "use Moose::Meta::At<tab>" |
115 | # will only begin looking in ../Moose/Meta/ |
f1f5a418 |
116 | for my $subdir (@directories) |
117 | { |
118 | $path = File::Spec->catdir($path, $subdir); |
119 | -d $path or next INC; |
120 | } |
121 | |
6c3218fe |
122 | $add_recursively->($path, 0); |
f1f5a418 |
123 | } |
124 | |
125 | return $orig->(@_), @found; |
126 | }; |
127 | |
128 | 1; |
129 | |
cfd1094b |
130 | __END__ |
131 | |
9d2a4940 |
132 | =pod |
cfd1094b |
133 | |
30b459d4 |
134 | =head1 AUTHOR |
135 | |
136 | Shawn M Moore, C<< <sartak at gmail dot com> >> |
137 | |
cfd1094b |
138 | =cut |