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