File Coverage

blib/lib/Devel/REPL/Plugin/CompletionDriver/Methods.pm
Criterion Covered Total %
statement 18 18 100.0
branch n/a
condition n/a
subroutine 6 6 100.0
pod 0 1 0.0
total 24 25 96.0


line stmt bran cond sub pod time code
1 2     2   1915 use strict;
  2         3  
  2         56  
2 2     2   6 use warnings;
  2         2  
  2         105  
3             package Devel::REPL::Plugin::CompletionDriver::Methods;
4             # ABSTRACT: Complete class or object method names
5              
6             our $VERSION = '1.003028';
7              
8 2     2   7 use Devel::REPL::Plugin;
  2         3  
  2         11  
9 2     2   6073 use Devel::REPL::Plugin::Completion; # die early if cannot load
  2         4  
  2         38  
10 2     2   7 use namespace::autoclean;
  2         2  
  2         12  
11              
12             sub BEFORE_PLUGIN {
13 1     1 0 2 my $self = shift;
14 1         3 for (qw/Completion FindVariable/) {
15 2         49 $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             =encoding UTF-8
78              
79             =head1 NAME
80              
81             Devel::REPL::Plugin::CompletionDriver::Methods - Complete class or object method names
82              
83             =head1 VERSION
84              
85             version 1.003028
86              
87             =head1 SUPPORT
88              
89             Bugs may be submitted through L<the RT bug tracker|https://rt.cpan.org/Public/Dist/Display.html?Name=Devel-REPL>
90             (or L<bug-Devel-REPL@rt.cpan.org|mailto:bug-Devel-REPL@rt.cpan.org>).
91              
92             There is also an irc channel available for users of this distribution, at
93             L<C<#devel> on C<irc.perl.org>|irc://irc.perl.org/#devel-repl>.
94              
95             =head1 AUTHOR
96              
97             Shawn M Moore, C<< <sartak at gmail dot com> >>
98              
99             =head1 COPYRIGHT AND LICENCE
100              
101             This software is copyright (c) 2007 by Matt S Trout - mst (at) shadowcatsystems.co.uk (L<http://www.shadowcatsystems.co.uk/>).
102              
103             This is free software; you can redistribute it and/or modify it under
104             the same terms as the Perl 5 programming language system itself.
105              
106             =cut