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   3020 use strict;
  2         4  
  2         72  
2 2     2   11 use warnings;
  2         4  
  2         153  
3             package Devel::REPL::Plugin::CompletionDriver::Globals;
4             # ABSTRACT: Complete global variables, packages, namespaced functions
5              
6             our $VERSION = '1.003027';
7              
8 2     2   15 use Devel::REPL::Plugin;
  2         5  
  2         18  
9 2     2   10161 use Devel::REPL::Plugin::Completion; # die early if cannot load
  2         2  
  2         65  
10 2     2   10 use namespace::autoclean;
  2         4  
  2         22  
11              
12             sub BEFORE_PLUGIN {
13 1     1 0 2 my $self = shift;
14 1         4 $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             =encoding UTF-8
70              
71             =head1 NAME
72              
73             Devel::REPL::Plugin::CompletionDriver::Globals - Complete global variables, packages, namespaced functions
74              
75             =head1 VERSION
76              
77             version 1.003027
78              
79             =head1 AUTHOR
80              
81             Shawn M Moore, C<< <sartak at gmail dot com> >>
82              
83             =head1 COPYRIGHT AND LICENSE
84              
85             This software is copyright (c) 2007 by Matt S Trout - mst (at) shadowcatsystems.co.uk (L<http://www.shadowcatsystems.co.uk/>).
86              
87             This is free software; you can redistribute it and/or modify it under
88             the same terms as the Perl 5 programming language system itself.
89              
90             =cut