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

   1 use strict;
   2 use warnings;
   3 package Devel::REPL::Plugin::CompletionDriver::Globals;
   4 # ABSTRACT: Complete global variables, packages, namespaced functions
   5
   6 our $VERSION = '1.003028';
   7
   8 use Devel::REPL::Plugin;
   9 use Devel::REPL::Plugin::Completion;    # die early if cannot load
  10 use namespace::autoclean;
  11
  12 sub BEFORE_PLUGIN {
  13     my $self = shift;
  14     $self->load_plugin('Completion');
  15 }
  16
  17 around complete => sub {
  18   my $orig = shift;
  19   my ($self, $text, $document) = @_;
  20
  21   my $last = $self->last_ppi_element($document);
  22
  23   return $orig->(@_)
  24     unless $last->isa('PPI::Token::Symbol')
  25         || $last->isa('PPI::Token::Word');
  26
  27   my $sigil = $last =~ s/^[\$\@\%\&\*]// ? $1 : undef;
  28   my $re = qr/^\Q$last/;
  29
  30   my @package_fragments = split qr/::|'/, $last;
  31
  32   # split drops the last fragment if it's empty
  33   push @package_fragments, '' if $last =~ /(?:'|::)$/;
  34
  35   # the beginning of the variable, or an incomplete package name
  36   my $incomplete = pop @package_fragments;
  37
  38   # recurse for the complete package fragments
  39   my $stash = \%::;
  40   for (@package_fragments) {
  41     $stash = $stash->{"$_\::"};
  42   }
  43
  44   # collect any variables from this stash
  45   my @found = grep { /$re/ }
  46               map  { join '::', @package_fragments, $_ }
  47               keys %$stash;
  48
  49   # check to see if it's an incomplete package name, and add its variables
  50   # so Devel<TAB> is completed correctly
  51   for my $key (keys %$stash) {
  52       next unless $key =~ /::$/;            # only look at deeper packages
  53       next unless $key =~ /^\Q$incomplete/; # only look at matching packages
  54       push @found,
  55         map { join '::', @package_fragments, $_ }
  56         map { "$key$_" } # $key already has trailing ::
  57         keys %{ $stash->{$key} };
  58   }
  59
  60   return $orig->(@_), @found;
  61 };
  62
  63 1;
  64
  65 __END__
  66
  67 =pod
  68
  69 =head1 AUTHOR
  70
  71 Shawn M Moore, C<< <sartak at gmail dot com> >>
  72
  73 =cut