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

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