lib/Devel/REPL/Plugin/CompletionDriver/INC.pm

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