File Coverage

blib/lib/Devel/REPL/Plugin/MultiLine/PPI.pm
Criterion Covered Total %
statement 15 38 39.4
branch 0 12 0.0
condition n/a
subroutine 5 8 62.5
pod 0 2 0.0
total 20 60 33.3


line stmt bran cond sub pod time code
1 2     2   3042 use strict;
  2         3  
  2         69  
2 2     2   9 use warnings;
  2         3  
  2         134  
3             package Devel::REPL::Plugin::MultiLine::PPI;
4             # ABSTRACT: Read lines until all blocks are closed
5              
6             our $VERSION = '1.003028';
7              
8 2     2   9 use Devel::REPL::Plugin;
  2         2  
  2         14  
9 2     2   8173 use PPI;
  2         2  
  2         55  
10 2     2   11 use namespace::autoclean;
  2         3  
  2         16  
11              
12             has 'continuation_prompt' => (
13             is => 'rw',
14             lazy => 1,
15             default => sub { '> ' }
16             );
17              
18             has 'line_depth' => (
19             is => 'rw',
20             lazy => 1,
21             default => sub { 0 }
22             );
23              
24             around 'read' => sub {
25             my $orig = shift;
26             my ($self, @args) = @_;
27             my $line = $self->$orig(@args);
28              
29             if (defined $line) {
30             return $self->continue_reading_if_necessary($line, @args);
31             } else {
32             return $line;
33             }
34             };
35              
36             sub continue_reading_if_necessary {
37 0     0 0   my ( $self, $line, @args ) = @_;
38              
39 0           while ($self->line_needs_continuation($line)) {
40 0           my $orig_prompt = $self->prompt;
41 0           $self->prompt($self->continuation_prompt);
42              
43 0           $self->line_depth($self->line_depth + 1);
44 0           my $append = $self->read(@args);
45 0           $self->line_depth($self->line_depth - 1);
46              
47 0 0         $line .= "\n$append" if defined($append);
48              
49 0           $self->prompt($orig_prompt);
50              
51             # ^D means "shut up and eval already"
52 0 0         return $line if !defined($append);
53             }
54              
55 0           return $line;
56             }
57              
58             sub line_needs_continuation
59             {
60 0     0 0   my $repl = shift;
61 0           my $line = shift;
62              
63             # add this so we can test whether the document ends in PPI::Statement::Null
64 0           $line .= "\n;;";
65              
66 0           my $document = PPI::Document->new(\$line);
67 0 0         return 0 if !defined($document);
68              
69             # adding ";" to a complete document adds a PPI::Statement::Null. we added a ;;
70             # so if it doesn't end in null then there's probably something that's
71             # incomplete
72 0 0         return 0 if $document->child(-1)->isa('PPI::Statement::Null');
73              
74             # this could use more logic, such as returning 1 on s/foo/ba<Enter>
75             my $unfinished_structure = sub
76             {
77 0     0     my ($document, $element) = @_;
78 0 0         return 0 unless $element->isa('PPI::Structure');
79 0 0         return 1 unless $element->finish;
80 0           return 0;
81 0           };
82              
83 0           return $document->find_any($unfinished_structure);
84             }
85              
86             1;
87              
88             __END__
89              
90             =pod
91              
92             =encoding UTF-8
93              
94             =head1 NAME
95              
96             Devel::REPL::Plugin::MultiLine::PPI - Read lines until all blocks are closed
97              
98             =head1 VERSION
99              
100             version 1.003028
101              
102             =head1 SYNOPSIS
103              
104             use Devel::REPL;
105              
106             my $repl = Devel::REPL->new;
107             $repl->load_plugin('LexEnv');
108             $repl->load_plugin('History');
109             $repl->load_plugin('MultiLine::PPI');
110             $repl->run;
111              
112             =head1 DESCRIPTION
113              
114             Plugin that will collect lines until you have no unfinished structures. This
115             lets you write subroutines, C<if> statements, loops, etc. more naturally.
116              
117             For example, without a MultiLine plugin,
118              
119             $ my $x = 3;
120             3
121             $ if ($x == 3) {
122              
123             will throw a compile error, because that C<if> statement is incomplete. With a
124             MultiLine plugin,
125              
126             $ my $x = 3;
127             3
128             $ if ($x == 3) {
129              
130             > print "OH NOES!"
131              
132             > }
133             OH NOES
134             1
135              
136             you may write the code across multiple lines, such as in C<irb> and C<python>.
137              
138             This module uses L<PPI>. This plugin is named C<MultiLine::PPI> because someone
139             else may conceivably implement similar behavior some other less
140             dependency-heavy way.
141              
142             =head1 SEE ALSO
143              
144             C<Devel::REPL>
145              
146             =head1 SUPPORT
147              
148             Bugs may be submitted through L<the RT bug tracker|https://rt.cpan.org/Public/Dist/Display.html?Name=Devel-REPL>
149             (or L<bug-Devel-REPL@rt.cpan.org|mailto:bug-Devel-REPL@rt.cpan.org>).
150              
151             There is also an irc channel available for users of this distribution, at
152             L<C<#devel> on C<irc.perl.org>|irc://irc.perl.org/#devel-repl>.
153              
154             =head1 AUTHOR
155              
156             Shawn M Moore, C<< <sartak at gmail dot com> >>
157              
158             =head1 COPYRIGHT AND LICENSE
159              
160             Copyright (C) 2007 by Shawn M Moore
161              
162             This library is free software; you can redistribute it and/or modify
163             it under the same terms as Perl itself.
164              
165             =cut