lib/Devel/REPL/Plugin/Commands.pm

   1 package Devel::REPL::Plugin::Commands;
   2
   3 use Devel::REPL::Plugin;
   4 use Scalar::Util qw(weaken);
   5
   6 use namespace::clean -except => [ 'meta' ];
   7 use vars qw($COMMAND_INSTALLER);
   8
   9 has 'command_set' => (
  10   is => 'ro', required => 1,
  11   lazy => 1, default => sub { {} }
  12 );
  13
  14 sub BEFORE_PLUGIN {
  15   my ($self) = @_;
  16   unless ($self->can('setup_commands')) {
  17     $self->meta->add_method('setup_commands' => sub {});
  18   }
  19 }
  20
  21 sub AFTER_PLUGIN {
  22   my ($self) = @_;
  23   $self->setup_commands;
  24 }
  25
  26 after 'setup_commands' => sub {
  27   my ($self) = @_;
  28   weaken($self);
  29   $self->command_set->{load_plugin} = sub {
  30     my $self = shift;
  31     sub { $self->load_plugin(@_); };
  32   };
  33 };
  34
  35 sub command_installer {
  36   my ($self) = @_;
  37   my $command_set = $self->command_set;
  38   my %command_subs = map {
  39     ($_ => $command_set->{$_}->($self));
  40   } keys %$command_set;
  41   return sub {
  42     my $package = shift;
  43     foreach my $command (keys %command_subs) {
  44       no strict 'refs';
  45       no warnings 'redefine';
  46       *{"${package}::${command}"} = $command_subs{$command};
  47     }
  48   };
  49 }
  50
  51 around 'mangle_line' => sub {
  52   my ($orig, $self) = (shift, shift);
  53   my ($line) = @_;
  54   my $name = '$'.__PACKAGE__.'::COMMAND_INSTALLER';
  55   return qq{BEGIN { ${name}->(__PACKAGE__) }\n}.$self->$orig(@_);
  56 };
  57
  58 around 'compile' => sub {
  59   my ($orig, $self) = (shift, shift);
  60   local $COMMAND_INSTALLER = $self->command_installer;
  61   $self->$orig(@_);
  62 };
  63
  64 1;