[Bast-commits] r4402 - trunk/Devel-REPL/lib/Devel/REPL/Plugin/CompletionDriver

[Sartak at dev.catalyst.perl.org]

Author: Sartak
Date: 2008-05-25 19:13:43 +0100 (Sun, 25 May 2008)
New Revision: 4402

Added:
   trunk/Devel-REPL/lib/Devel/REPL/Plugin/CompletionDriver/Globals.pm
Log:
Devel::REPL::Plugin::CompletionDriver::Globals


Added: trunk/Devel-REPL/lib/Devel/REPL/Plugin/CompletionDriver/Globals.pm
===================================================================
--- trunk/Devel-REPL/lib/Devel/REPL/Plugin/CompletionDriver/Globals.pm	                        (rev 0)
+++ trunk/Devel-REPL/lib/Devel/REPL/Plugin/CompletionDriver/Globals.pm	2008-05-25 18:13:43 UTC (rev 4402)
@@ -0,0 +1,51 @@
+package Devel::REPL::Plugin::CompletionDriver::Globals;
+use Devel::REPL::Plugin;
+use namespace::clean -except => [ 'meta' ];
+
+around complete => sub {
+  my $orig = shift;
+  my ($self, $text, $document) = @_;
+
+  my $last = $self->last_ppi_element($document);
+
+  return $orig->(@_)
+    unless $last->isa('PPI::Token::Symbol');
+
+  my $sigil = substr($last, 0, 1, '');
+  my $re = qr/^\Q$last/;
+
+  my @package_fragments = split qr/::|'/, $last;
+
+  # split drops the last fragment if it's empty
+  push @package_fragments, '' if $last =~ /(?:'|::)$/;
+
+  # the beginning of the variable, or an incomplete package name
+  my $incomplete = pop @package_fragments;
+
+  # recurse for the complete package fragments
+  my $stash = \%::;
+  for (@package_fragments) {
+    $stash = $stash->{"$_\::"};
+  }
+
+  # collect any variables from this stash
+  my @found = grep { /$re/ }
+              map  { join '::', @package_fragments, $_ }
+              keys %$stash;
+
+  # check to see if it's an incomplete package name, and add its variables
+  # so Devel<TAB> is completed correctly
+  for my $key (keys %$stash) {
+      next unless $key =~ /::$/;            # only look at deeper packages
+      next unless $key =~ /^\Q$incomplete/; # only look at matching packages
+      push @found,
+        map { join '::', @package_fragments, $_ }
+        map { "$key$_" } # $key already has trailing ::
+        keys %{ $stash->{$key} };
+  }
+
+  return $orig->(@_), @found;
+};
+
+1;
+