X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=p5sagit%2FDevel-REPL.git;a=blobdiff_plain;f=lib%2FDevel%2FREPL%2FPlugin%2FPackages.pm;h=a7e13fe0b9e6596f36924021326b609b7ec154bb;hp=5d8ff78663e73cdfc68e5c1961550e175fd61cb9;hb=6f4f9516b3422a8ce51b89b596fb808b197f833e;hpb=80f0324ccb990cd887d8a740e20a0d250a70d379

diff --git a/lib/Devel/REPL/Plugin/Packages.pm b/lib/Devel/REPL/Plugin/Packages.pm
index 5d8ff78..a7e13fe 100644
--- a/lib/Devel/REPL/Plugin/Packages.pm
+++ b/lib/Devel/REPL/Plugin/Packages.pm
@@ -1,48 +1,63 @@
-# First cut at handling packages.
-#
-# doesn't work very well, and totally doesn't work with the wrap_as_sub
-# stuff ;) For comments only really
-
+use strict;
+use warnings;
 package Devel::REPL::Plugin::Packages;
 
-use Moose::Role;
+use Devel::REPL::Plugin;
+use namespace::autoclean;
+
+our $PKG_SAVE;
 
 has 'current_package' => (
   isa      => 'Str',
   is       => 'rw',
-  default  => 'main',
+  default  => 'Devel::REPL::Plugin::Packages::DefaultScratchpad',
   lazy     => 1
 );
 
+around 'wrap_as_sub' => sub {
+  my $orig = shift;
+  my ($self, @args) = @_;
+  my $line = $self->$orig(@args);
+  # prepend package def before sub { ... }
+  return q!package !.$self->current_package.qq!;\n${line}!;
+};
+
+around 'mangle_line' => sub {
+  my $orig = shift;
+  my ($self, @args) = @_;
+  my $line = $self->$orig(@args);
+  # add a BEGIN block to set the package around at the end of the sub
+  # without mangling the return value (we save it off into a global)
+  $line .= '
+; BEGIN { $Devel::REPL::Plugin::Packages::PKG_SAVE = __PACKAGE__; }';
+  return $line;
+};
+
+after 'execute' => sub {
+  my ($self) = @_;
+  # if we survived execution successfully, save the new package out the global
+  $self->current_package($PKG_SAVE) if defined $PKG_SAVE;
+};
+
 around 'eval' => sub {
-# we don't call forward to $orig here, since the new sub-wrapped system
-# doesn't work. We spot package declarations and retain the name so
-# that we can reenter the package for each statement. Not sure the
-# regex is bob on, but then it doesn't work anyway...
-  my $orig=shift;
-  my ($self, $line)=@_;
-
-  my @ret=("OOPS: ".__PACKAGE__.'$ret unset!');
-
-#  $self->print("Line is: $line");
-  if($line=~/\s*package\s([\w:]*)/) {
-#    $self->print("Recognised as a package switch");
-#    $ret=$self->$orig($line);
-    @ret=eval $line;
-#    $self->print("ret: @ret");
-    # should check for good return here
-    $self->current_package($1);
-#    $self->print('curr pkg: '.$self->current_package);
-  } else {
-#    $self->print("Not a package switch");
-    my $packaged_line='package ' . $self->current_package . '; '.$line;
-#    $self->print("packaged line: $packaged_line");
-#    @ret=$self->$orig($packaged_line);
-    @ret=eval $packaged_line;
-#    $self->print("ret: @ret");
-  }
-  return @ret;
+  my $orig = shift;
+  my ($self, @args) = @_;
+  # localise the $PKG_SAVE global in case of nested evals
+  local $PKG_SAVE;
+  return $self->$orig(@args);
 };
 
+package Devel::REPL::Plugin::Packages::DefaultScratchpad;
+
+# declare empty scratchpad package for cleanliness
+
 1;
 
+__END__
+
+=head1 NAME
+
+Devel::REPL::Plugin::Packages - Keep track of which package the user is in
+
+=cut
+