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