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