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