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