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