File: LexEnv.pm

package info (click to toggle)
libdevel-repl-perl 1.003028-1
  • links: PTS, VCS
  • area: main
  • in suites: bullseye, buster, stretch
  • size: 524 kB
  • ctags: 106
  • sloc: perl: 1,767; makefile: 2
file content (121 lines) | stat: -rw-r--r-- 2,988 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
use strict;
use warnings;
package Devel::REPL::Plugin::LexEnv;
# ABSTRACT: Provide a lexical environment for the REPL

our $VERSION = '1.003028';

use Devel::REPL::Plugin;
use namespace::autoclean;
use Lexical::Persistence;

sub BEFORE_PLUGIN {
    my $self = shift;
    $self->load_plugin('FindVariable');
}

has 'lexical_environment' => (
  isa => 'Lexical::Persistence',
  is => 'rw',
  lazy => 1,
  default => sub { Lexical::Persistence->new }
);

has '_hints' => (
  isa => "ArrayRef",
  is => "rw",
  predicate => '_has_hints',
);

around 'mangle_line' => sub {
  my $orig = shift;
  my ($self, @rest) = @_;
  my $line = $self->$orig(@rest);
  my $lp = $self->lexical_environment;
  # Collate my declarations for all LP context vars then add '';
  # so an empty statement doesn't return anything (with a no warnings
  # to prevent "Useless use ..." warning)
  return join('',
    'BEGIN { if ( $_REPL->_has_hints ) { ( $^H, %^H ) = @{ $_REPL->_hints } } }',
    ( map { "my $_;\n" } keys %{$lp->get_context('_')} ),
    qq{{ no warnings 'void'; ''; }\n},
    $line,
    '; BEGIN { $_REPL->_hints([ $^H, %^H ]) }',
  );
};

around 'execute' => sub {
  my $orig = shift;
  my ($self, $to_exec, @rest) = @_;
  my $wrapped = $self->lexical_environment->wrap($to_exec);
  return $self->$orig($wrapped, @rest);
};

# this doesn't work! yarg. we now just check $self->can('lexical_environment')
# in FindVariable

#around 'find_variable' => sub {
#  my $orig = shift;
#  my ($self, $name) = @_;
#
#  return \( $self->lexical_environment->get_context('_')->{$name} )
#    if exists $self->lexical_environment->get_context('_')->{$name};
#
#  return $orig->(@_);
#};

1;

__END__

=pod

=encoding UTF-8

=head1 NAME

Devel::REPL::Plugin::LexEnv - Provide a lexical environment for the REPL

=head1 VERSION

version 1.003028

=head1 SYNOPSIS

 # in your re.pl file:
 use Devel::REPL;
 my $repl = Devel::REPL->new;
 $repl->load_plugin('LexEnv');

 $repl->lexical_environment->do(<<'CODEZ');
 use FindBin;
 use lib "$FindBin::Bin/../lib";
 use MyApp::Schema;
 my $s = MyApp::Schema->connect('dbi:Pg:dbname=foo','broseph','elided');
 CODEZ

 $repl->run;

 # after you run re.pl:
 $ warn $s->resultset('User')->first->first_name # <-- note that $s works

=head1 SUPPORT

Bugs may be submitted through L<the RT bug tracker|https://rt.cpan.org/Public/Dist/Display.html?Name=Devel-REPL>
(or L<bug-Devel-REPL@rt.cpan.org|mailto:bug-Devel-REPL@rt.cpan.org>).

There is also an irc channel available for users of this distribution, at
L<C<#devel> on C<irc.perl.org>|irc://irc.perl.org/#devel-repl>.

=head1 AUTHOR

Matt S Trout - mst (at) shadowcatsystems.co.uk (L<http://www.shadowcatsystems.co.uk/>)

=head1 COPYRIGHT AND LICENCE

This software is copyright (c) 2007 by Matt S Trout - mst (at) shadowcatsystems.co.uk (L<http://www.shadowcatsystems.co.uk/>).

This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.

=cut