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

   1 use strict;
   2 use warnings;
   3 package Devel::REPL::Plugin::CompletionDriver::Methods;
   4 # ABSTRACT: Complete class or object method names
   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     for (qw/Completion FindVariable/) {
  15         $self->load_plugin($_);
  16     }
  17 }
  18
  19 around complete => sub {
  20   my $orig = shift;
  21   my ($self, $text, $document) = @_;
  22
  23   my $last = $self->last_ppi_element($document);
  24   my $incomplete = '';
  25
  26   # handle an incomplete method name, and back up to the ->
  27   if ($last->isa('PPI::Token::Word')) {
  28       my $previous = $last->sprevious_sibling
  29         or return $orig->(@_);
  30       $previous->isa('PPI::Token::Operator') && $previous->content eq '->'
  31         or return $orig->(@_);
  32       $incomplete = $last->content;
  33       $last = $previous;
  34   }
  35
  36   # require a -> here
  37   return $orig->(@_)
  38     unless $last->isa('PPI::Token::Operator')
  39         && $last->content eq '->';
  40
  41   # ..which is preceded by a word (class name)
  42   my $previous = $last->sprevious_sibling
  43     or return $orig->(@_);
  44   $previous->isa('PPI::Token::Word') || $previous->isa('PPI::Token::Symbol')
  45     or return $orig->(@_);
  46   my $class;
  47
  48   # we have a variable, need to look up its class
  49   if ($previous->isa('PPI::Token::Symbol')) {
  50     my $object_ref = $self->find_variable($previous->content)
  51       or return $orig->(@_);
  52     $class = blessed($$object_ref)
  53       or return $orig->(@_);
  54   }
  55   else  {
  56     $class = $previous->content;
  57   }
  58
  59   # now we have $class->$incomplete
  60
  61   my $metaclass = Class::MOP::Class->initialize($class);
  62
  63   my $re = qr/^\Q$incomplete/;
  64
  65   return $orig->(@_),
  66          grep { $_ =~ $re }
  67          map  { $_->name }
  68          $metaclass->get_all_methods;
  69 };
  70
  71 1;
  72
  73 __END__
  74
  75 =pod
  76
  77 =head1 AUTHOR
  78
  79 Shawn M Moore, C<< <sartak at gmail dot com> >>
  80
  81 =cut