File Coverage

blib/lib/Devel/REPL/Plugin/Packages.pm
Criterion Covered Total %
statement 12 12 100.0
branch n/a
condition n/a
subroutine 4 4 100.0
pod n/a
total 16 16 100.0


line stmt bran cond sub pod time code
1 2     2   28920 use strict;
  2         5  
  2         84  
2 2     2   13 use warnings;
  2         4  
  2         156  
3             package Devel::REPL::Plugin::Packages;
4             # ABSTRACT: Keep track of which package the user is in
5              
6             our $VERSION = '1.003027';
7              
8 2     2   14 use Devel::REPL::Plugin;
  2         3  
  2         21  
9 2     2   10445 use namespace::autoclean;
  2         5  
  2         25  
10              
11             our $PKG_SAVE;
12              
13             has 'current_package' => (
14             isa => 'Str',
15             is => 'rw',
16             default => 'Devel::REPL::Plugin::Packages::DefaultScratchpad',
17             lazy => 1
18             );
19              
20             around 'wrap_as_sub' => sub {
21             my $orig = shift;
22             my ($self, @args) = @_;
23             my $line = $self->$orig(@args);
24             # prepend package def before sub { ... }
25             return q!package !.$self->current_package.qq!;\n${line}!;
26             };
27              
28             around 'mangle_line' => sub {
29             my $orig = shift;
30             my ($self, @args) = @_;
31             my $line = $self->$orig(@args);
32             # add a BEGIN block to set the package around at the end of the sub
33             # without mangling the return value (we save it off into a global)
34             $line .= '
35             ; BEGIN { $Devel::REPL::Plugin::Packages::PKG_SAVE = __PACKAGE__; }';
36             return $line;
37             };
38              
39             after 'execute' => sub {
40             my ($self) = @_;
41             # if we survived execution successfully, save the new package out the global
42             $self->current_package($PKG_SAVE) if defined $PKG_SAVE;
43             };
44              
45             around 'eval' => sub {
46             my $orig = shift;
47             my ($self, @args) = @_;
48             # localise the $PKG_SAVE global in case of nested evals
49             local $PKG_SAVE;
50             return $self->$orig(@args);
51             };
52              
53             package # hide from PAUSE
54             Devel::REPL::Plugin::Packages::DefaultScratchpad;
55              
56             # declare empty scratchpad package for cleanliness
57              
58             1;
59              
60             __END__
61              
62             =pod
63              
64             =encoding UTF-8
65              
66             =head1 NAME
67              
68             Devel::REPL::Plugin::Packages - Keep track of which package the user is in
69              
70             =head1 VERSION
71              
72             version 1.003027
73              
74             =head1 AUTHOR
75              
76             Matt S Trout - mst (at) shadowcatsystems.co.uk (L<http://www.shadowcatsystems.co.uk/>)
77              
78             =head1 COPYRIGHT AND LICENSE
79              
80             This software is copyright (c) 2007 by Matt S Trout - mst (at) shadowcatsystems.co.uk (L<http://www.shadowcatsystems.co.uk/>).
81              
82             This is free software; you can redistribute it and/or modify it under
83             the same terms as the Perl 5 programming language system itself.
84              
85             =cut