File Coverage

blib/lib/Devel/REPL/Plugin/CompletionDriver/Globals.pm
Criterion Covered Total %
statement 17 17 100.0
branch n/a
condition n/a
subroutine 6 6 100.0
pod 0 1 0.0
total 23 24 95.8


line stmt bran cond sub pod time code
1 2     2   2191 use strict;
  2         3  
  2         60  
2 2     2   9 use warnings;
  2         7  
  2         105  
3             # ABSTRACT: Complete global variables, packages, namespaced functions
4              
5             our $VERSION = '1.003029';
6              
7             use Devel::REPL::Plugin;
8 2     2   11 use Devel::REPL::Plugin::Completion; # die early if cannot load
  2         15  
  2         14  
9 2     2   8609 use namespace::autoclean;
  2         7  
  2         46  
10 2     2   10  
  2         4  
  2         19  
11             my $self = shift;
12             $self->load_plugin('Completion');
13 1     1 0 4 }
14 1         7  
15             around complete => sub {
16             my $orig = shift;
17             my ($self, $text, $document) = @_;
18              
19             my $last = $self->last_ppi_element($document);
20              
21             return $orig->(@_)
22             unless $last->isa('PPI::Token::Symbol')
23             || $last->isa('PPI::Token::Word');
24              
25             my $sigil = $last =~ s/^[\$\@\%\&\*]// ? $1 : undef;
26             my $re = qr/^\Q$last/;
27              
28             my @package_fragments = split qr/::|'/, $last;
29              
30             # split drops the last fragment if it's empty
31             push @package_fragments, '' if $last =~ /(?:'|::)$/;
32              
33             # the beginning of the variable, or an incomplete package name
34             my $incomplete = pop @package_fragments;
35              
36             # recurse for the complete package fragments
37             my $stash = \%::;
38             for (@package_fragments) {
39             $stash = $stash->{"$_\::"};
40             }
41              
42             # collect any variables from this stash
43             my @found = grep { /$re/ }
44             map { join '::', @package_fragments, $_ }
45             keys %$stash;
46              
47             # check to see if it's an incomplete package name, and add its variables
48             # so Devel<TAB> is completed correctly
49             for my $key (keys %$stash) {
50             next unless $key =~ /::$/; # only look at deeper packages
51             next unless $key =~ /^\Q$incomplete/; # only look at matching packages
52             push @found,
53             map { join '::', @package_fragments, $_ }
54             map { "$key$_" } # $key already has trailing ::
55             keys %{ $stash->{$key} };
56             }
57              
58             return $orig->(@_), @found;
59             };
60              
61             1;
62              
63              
64             =pod
65              
66             =encoding UTF-8
67              
68             =head1 NAME
69              
70             Devel::REPL::Plugin::CompletionDriver::Globals - Complete global variables, packages, namespaced functions
71              
72             =head1 VERSION
73              
74             version 1.003029
75              
76             =head1 SUPPORT
77              
78             Bugs may be submitted through L<the RT bug tracker|https://rt.cpan.org/Public/Dist/Display.html?Name=Devel-REPL>
79             (or L<bug-Devel-REPL@rt.cpan.org|mailto:bug-Devel-REPL@rt.cpan.org>).
80              
81             There is also an irc channel available for users of this distribution, at
82             L<C<#devel> on C<irc.perl.org>|irc://irc.perl.org/#devel-repl>.
83              
84             =head1 AUTHOR
85              
86             Shawn M Moore, C<< <sartak at gmail dot com> >>
87              
88             =head1 COPYRIGHT AND LICENCE
89              
90             This software is copyright (c) 2007 by Matt S Trout - mst (at) shadowcatsystems.co.uk (L<http://www.shadowcatsystems.co.uk/>).
91              
92             This is free software; you can redistribute it and/or modify it under
93             the same terms as the Perl 5 programming language system itself.
94              
95             =cut