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