File Coverage

blib/lib/Devel/REPL/Plugin/LexEnv.pm
Criterion Covered Total %
statement 17 17 100.0
branch n/a
condition n/a
subroutine 6 6 100.0
pod 0 1 0.0
total 23 24 95.8


line stmt bran cond sub pod time code
1 2     2   2228 use strict;
  2         4  
  2         62  
2 2     2   9 use warnings;
  2         4  
  2         132  
3             # ABSTRACT: Provide a lexical environment for the REPL
4              
5             our $VERSION = '1.003029';
6              
7             use Devel::REPL::Plugin;
8 2     2   11 use namespace::autoclean;
  2         4  
  2         13  
9 2     2   8686 use Lexical::Persistence;
  2         4  
  2         20  
10 2     2   826  
  2         4491  
  2         540  
11             my $self = shift;
12             $self->load_plugin('FindVariable');
13 1     1 0 3 }
14 1         7  
15             has 'lexical_environment' => (
16             isa => 'Lexical::Persistence',
17             is => 'rw',
18             lazy => 1,
19             default => sub { Lexical::Persistence->new }
20             );
21              
22             has '_hints' => (
23             isa => "ArrayRef",
24             is => "rw",
25             predicate => '_has_hints',
26             );
27              
28             around 'mangle_line' => sub {
29             my $orig = shift;
30             my ($self, @rest) = @_;
31             my $line = $self->$orig(@rest);
32             my $lp = $self->lexical_environment;
33             # Collate my declarations for all LP context vars then add '';
34             # so an empty statement doesn't return anything (with a no warnings
35             # to prevent "Useless use ..." warning)
36             return join('',
37             'BEGIN { if ( $_REPL->_has_hints ) { ( $^H, %^H ) = @{ $_REPL->_hints } } }',
38             ( map { "my $_;\n" } keys %{$lp->get_context('_')} ),
39             qq{{ no warnings 'void'; ''; }\n},
40             $line,
41             '; BEGIN { $_REPL->_hints([ $^H, %^H ]) }',
42             );
43             };
44              
45             around 'execute' => sub {
46             my $orig = shift;
47             my ($self, $to_exec, @rest) = @_;
48             my $wrapped = $self->lexical_environment->wrap($to_exec);
49             return $self->$orig($wrapped, @rest);
50             };
51              
52             # this doesn't work! yarg. we now just check $self->can('lexical_environment')
53             # in FindVariable
54              
55             #around 'find_variable' => sub {
56             # my $orig = shift;
57             # my ($self, $name) = @_;
58             #
59             # return \( $self->lexical_environment->get_context('_')->{$name} )
60             # if exists $self->lexical_environment->get_context('_')->{$name};
61             #
62             # return $orig->(@_);
63             #};
64              
65             1;
66              
67              
68             =pod
69              
70             =encoding UTF-8
71              
72             =head1 NAME
73              
74             Devel::REPL::Plugin::LexEnv - Provide a lexical environment for the REPL
75              
76             =head1 VERSION
77              
78             version 1.003029
79              
80             =head1 SYNOPSIS
81              
82             # in your re.pl file:
83             use Devel::REPL;
84             my $repl = Devel::REPL->new;
85             $repl->load_plugin('LexEnv');
86              
87             $repl->lexical_environment->do(<<'CODEZ');
88             use FindBin;
89             use lib "$FindBin::Bin/../lib";
90             use MyApp::Schema;
91             my $s = MyApp::Schema->connect('dbi:Pg:dbname=foo','broseph','elided');
92             CODEZ
93              
94             $repl->run;
95              
96             # after you run re.pl:
97             $ warn $s->resultset('User')->first->first_name # <-- note that $s works
98              
99             =head1 SUPPORT
100              
101             Bugs may be submitted through L<the RT bug tracker|https://rt.cpan.org/Public/Dist/Display.html?Name=Devel-REPL>
102             (or L<bug-Devel-REPL@rt.cpan.org|mailto:bug-Devel-REPL@rt.cpan.org>).
103              
104             There is also an irc channel available for users of this distribution, at
105             L<C<#devel> on C<irc.perl.org>|irc://irc.perl.org/#devel-repl>.
106              
107             =head1 AUTHOR
108              
109             Matt S Trout - mst (at) shadowcatsystems.co.uk (L<http://www.shadowcatsystems.co.uk/>)
110              
111             =head1 COPYRIGHT AND LICENCE
112              
113             This software is copyright (c) 2007 by Matt S Trout - mst (at) shadowcatsystems.co.uk (L<http://www.shadowcatsystems.co.uk/>).
114              
115             This is free software; you can redistribute it and/or modify it under
116             the same terms as the Perl 5 programming language system itself.
117              
118             =cut