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   my %ignored =
  61   (
  62       '.'    => 1,
  63       '..'   => 1,
  64       '.svn' => 1,
  65   );
  66
  67   my $add_recursively;
  68   $add_recursively = sub {
  69     my ($path, $iteration, @more) = @_;
  70     opendir((my $dirhandle), $path);
  71     for (grep { !$ignored{$_} } readdir $dirhandle)
  72     {
  73       my $match = $_;
  74
  75       # if this is the first time around, we need respect whatever the user had
  76       # at the very end when he pressed tab
  77       next if $iteration == 0 && $match !~ $final_re;
  78
  79       my $fullmatch = File::Spec->rel2abs($match, $path);
  80       if (-d $fullmatch)
  81       {
  82         $add_recursively->($fullmatch, $iteration + 1, @more, $match);
  83       }
  84       else
  85       {
  86         $match =~ s/\..*// unless $keep_extension;
  87         push @found, join '', $prefix,
  88                               join $outsep, @directories, @more, $match;
  89       }
  90     }
  91   };
  92
  93   INC: for (@INC)
  94   {
  95     my $path = $_;
  96     for my $subdir (@directories)
  97     {
  98       $path = File::Spec->catdir($path, $subdir);
  99       -d $path or next INC;
 100     }
 101
 102     $add_recursively->($path, 0);
 103   }
 104
 105   return $orig->(@_), @found;
 106 };
 107
 108 1;
 109