lib/Devel/REPL/Plugin/Packages.pm

   1 package Devel::REPL::Plugin::Packages;
   2 use Devel::REPL::Plugin;
   3
   4 use namespace::sweep;
   5 use MooX::Types::MooseLike::Base qw(Str);
   6
   7 use vars qw($PKG_SAVE);
   8
   9 has 'current_package' => (
  10   isa      => Str,
  11   is       => 'rw',
  12   default  => sub { 'Devel::REPL::Plugin::Packages::DefaultScratchpad' },
  13   lazy     => 1
  14 );
  15
  16 around 'wrap_as_sub' => sub {
  17   my $orig = shift;
  18   my ($self, @args) = @_;
  19   my $line = $self->$orig(@args);
  20   # prepend package def before sub { ... }
  21   return q!package !.$self->current_package.qq!;\n${line}!;
  22 };
  23
  24 around 'mangle_line' => sub {
  25   my $orig = shift;
  26   my ($self, @args) = @_;
  27   my $line = $self->$orig(@args);
  28   # add a BEGIN block to set the package around at the end of the sub
  29   # without mangling the return value (we save it off into a global)
  30   $line .= '
  31 ; BEGIN { $Devel::REPL::Plugin::Packages::PKG_SAVE = __PACKAGE__; }';
  32   return $line;
  33 };
  34
  35 after 'execute' => sub {
  36   my ($self) = @_;
  37   # if we survived execution successfully, save the new package out the global
  38   $self->current_package($PKG_SAVE) if defined $PKG_SAVE;
  39 };
  40
  41 around 'eval' => sub {
  42   my $orig = shift;
  43   my ($self, @args) = @_;
  44   # localise the $PKG_SAVE global in case of nested evals
  45   local $PKG_SAVE;
  46   return $self->$orig(@args);
  47 };
  48
  49 package Devel::REPL::Plugin::Packages::DefaultScratchpad;
  50
  51 # declare empty scratchpad package for cleanliness
  52
  53 1;
  54
  55 __END__
  56
  57 =head1 NAME
  58
  59 Devel::REPL::Plugin::Packages - Keep track of which package the user is in
  60
  61 =cut
  62