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