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
  30   # require "Module"
  31   if ($package->isa('PPI::Token::Quote'))
  32   {
  33     $outsep = $insep = '/';
  34     $keep_extension = 1;
  35   }
  36   elsif ($package =~ /'/)
  37   {
  38     # the goofball is using the ancient ' package sep, we'll humor him
  39     $outsep = q{'};
  40     $insep = "'|::";
  41   }
  42
  43   my @directories = split $insep, $package;
  44
  45   # split drops trailing fields
  46   push @directories, '' if $package =~ /(?:$insep)$/;
  47   my $final = pop @directories;
  48   my $final_re = qr/^\Q$final/;
  49
  50   my @found;
  51
  52   my $add_recursively;
  53   $add_recursively = sub {
  54     my ($path, $iteration, @more) = @_;
  55     opendir((my $dirhandle), $path);
  56     for (readdir $dirhandle)
  57     {
  58       next if /^\.+$/; # skip . and ..
  59       next if $iteration == 0 && $_ !~ $final_re;
  60
  61       my $match = $_;
  62       my $fullmatch = File::Spec->rel2abs($match, $path);
  63       if (-d $fullmatch)
  64       {
  65         $add_recursively->($fullmatch, $iteration + 1, @more, $match);
  66       }
  67       else
  68       {
  69         $match =~ s/\..*// unless $keep_extension;
  70         push @found, join $outsep, @directories, @more, $match;
  71       }
  72     }
  73   };
  74
  75   INC: for (@INC)
  76   {
  77     my $path = $_;
  78     for my $subdir (@directories)
  79     {
  80       $path = File::Spec->catdir($path, $subdir);
  81       -d $path or next INC;
  82     }
  83
  84     $add_recursively->($path, 0);
  85   }
  86
  87   return $orig->(@_), @found;
  88 };
  89
  90 1;
  91