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

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