[Bast-commits] r3760 - in trunk/Devel-REPL: . lib/Devel/REPL/Plugin lib/Devel/REPL/Plugin/MultiLine

[Sartak at dev.catalyst.perl.org]

Author: Sartak
Date: 2007-09-21 01:06:05 +0100 (Fri, 21 Sep 2007)
New Revision: 3760

Added:
   trunk/Devel-REPL/lib/Devel/REPL/Plugin/MultiLine/
   trunk/Devel-REPL/lib/Devel/REPL/Plugin/MultiLine/PPI.pm
Modified:
   trunk/Devel-REPL/Makefile.PL
Log:
Add Devel::REPL::Plugin::MutliLine::PPI


Modified: trunk/Devel-REPL/Makefile.PL
===================================================================
--- trunk/Devel-REPL/Makefile.PL	2007-09-21 00:02:12 UTC (rev 3759)
+++ trunk/Devel-REPL/Makefile.PL	2007-09-21 00:06:05 UTC (rev 3760)
@@ -17,6 +17,7 @@
 requires 'Term::ReadLine';
 requires 'Lexical::Persistence';
 requires 'Data::Dump::Streamer';
+requires 'PPI';
 
 auto_install;
 WriteAll;

Added: trunk/Devel-REPL/lib/Devel/REPL/Plugin/MultiLine/PPI.pm
===================================================================
--- trunk/Devel-REPL/lib/Devel/REPL/Plugin/MultiLine/PPI.pm	                        (rev 0)
+++ trunk/Devel-REPL/lib/Devel/REPL/Plugin/MultiLine/PPI.pm	2007-09-21 00:06:05 UTC (rev 3760)
@@ -0,0 +1,52 @@
+package Devel::REPL::Plugin::MultiLine::PPI;
+
+use Moose::Role;
+use PPI;
+use namespace::clean -except => [ 'meta' ];
+
+has 'continuation_prompt' => (
+  is => 'rw', required => 1, lazy => 1,
+  default => sub { '> ' }
+);
+
+around 'read' => sub {
+  my $orig = shift;
+  my ($self, @args) = @_;
+  my $line = $self->$orig(@args);
+
+  if (defined $line) {
+    while (needs_continuation($line)) {
+      my $orig_prompt = $self->prompt;
+      $self->prompt($self->continuation_prompt);
+
+      my $append = $self->read(@args);
+      $line .= $append if defined($append);
+
+      $self->prompt($orig_prompt);
+
+      # ^D means "shut up and eval already"
+      return $line if !defined($append);
+    }
+  }
+  return $line;
+};
+
+sub needs_continuation
+{
+  my $line = shift;
+  my $document = PPI::Document->new(\$line);
+  return 0 if !defined($document);
+
+  # this could use more logic, such as returning 1 on s/foo/ba<Enter>
+  my $unfinished_structure = sub
+  {
+    my ($document, $element) = @_;
+    return 0 unless $element->isa('PPI::Structure');
+    return 1 unless $element->start && $element->finish;
+    return 0;
+  };
+
+  return $document->find_any($unfinished_structure);
+}
+
+1;