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 { $self->load_plugin(@_); };
  30 };
  31
  32 sub command_installer {
  33   my ($self) = @_;
  34   my %command_set = %{$self->command_set};
  35   return sub {
  36     my $package = shift;
  37     foreach my $command (keys %command_set) {
  38       no strict 'refs';
  39       no warnings 'redefine';
  40       *{"${package}::${command}"} = $command_set{$command};
  41     }
  42   };
  43 }
  44
  45 around 'mangle_line' => sub {
  46   my ($orig, $self) = (shift, shift);
  47   my ($line) = @_;
  48   my $name = '$'.__PACKAGE__.'::COMMAND_INSTALLER';
  49   return qq{BEGIN { ${name}->(__PACKAGE__) }\n}.$self->$orig(@_);
  50 };
  51
  52 around 'compile' => sub {
  53   my ($orig, $self) = (shift, shift);
  54   local $COMMAND_INSTALLER = $self->command_installer;
  55   $self->$orig(@_);
  56 };
  57
  58 1;