From: Sartak <Sartak@bd8105ee-0ff8-0310-8827-fb3f25b6796d>
Date: Sun, 25 May 2008 18:13:43 +0000 (+0000)
Subject: Devel::REPL::Plugin::CompletionDriver::Globals
X-Git-Tag: v1.003015~107
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=p5sagit%2FDevel-REPL.git;a=commitdiff_plain;h=908733a9f76e870c4518684ccd9c20ea692fd98c

Devel::REPL::Plugin::CompletionDriver::Globals


git-svn-id: http://dev.catalyst.perl.org/repos/bast/trunk/Devel-REPL@4402 bd8105ee-0ff8-0310-8827-fb3f25b6796d
---

diff --git a/lib/Devel/REPL/Plugin/CompletionDriver/Globals.pm b/lib/Devel/REPL/Plugin/CompletionDriver/Globals.pm
new file mode 100644
index 0000000..798ba51
--- /dev/null
+++ b/lib/Devel/REPL/Plugin/CompletionDriver/Globals.pm
@@ -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;
+