increment $VERSION after 1.003028 release
[p5sagit/Devel-REPL.git] / lib / Devel / REPL / Plugin / CompletionDriver / INC.pm
CommitLineData
1716b200 1use strict;
2use warnings;
f1f5a418 3package Devel::REPL::Plugin::CompletionDriver::INC;
9d2a4940 4# ABSTRACT: Complete module names in use and require
6f4f9516 5
c45376f3 6our $VERSION = '1.003029';
54beb05d 7
f1f5a418 8use Devel::REPL::Plugin;
b1c83802 9use Devel::REPL::Plugin::Completion; # die early if cannot load
f1f5a418 10use File::Next;
11use File::Spec;
aa8b7647 12use namespace::autoclean;
f1f5a418 13
3a400715 14sub BEFORE_PLUGIN {
15 my $self = shift;
16 $self->load_plugin('Completion');
17}
6631e15c 18
f1f5a418 19around 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
1281;
129
cfd1094b 130__END__
131
9d2a4940 132=pod
cfd1094b 133
30b459d4 134=head1 AUTHOR
135
136Shawn M Moore, C<< <sartak at gmail dot com> >>
137
cfd1094b 138=cut