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   $self->load_plugin('Packages');
  17   unless ($self->can('setup_commands')) {
  18     $self->meta->add_method('setup_commands' => sub {});
  19   }
  20 }
  21
  22 sub AFTER_PLUGIN {
  23   my ($self) = @_;
  24   $self->setup_commands;
  25 }
  26
  27 after 'setup_commands' => sub {
  28   my ($self) = @_;
  29   weaken($self);
  30   $self->command_set->{load_plugin} = sub {
  31     my $self = shift;
  32     sub { $self->load_plugin(@_); };
  33   };
  34 };
  35
  36 sub command_installer {
  37   my ($self) = @_;
  38   my $command_set = $self->command_set;
  39   my %command_subs = map {
  40     ($_ => $command_set->{$_}->($self));
  41   } keys %$command_set;
  42   return sub {
  43     my $package = shift;
  44     foreach my $command (keys %command_subs) {
  45       no strict 'refs';
  46       no warnings 'redefine';
  47       *{"${package}::${command}"} = $command_subs{$command};
  48     }
  49   };
  50 }
  51
  52 around 'mangle_line' => sub {
  53   my ($orig, $self) = (shift, shift);
  54   my ($line) = @_;
  55   my $name = '$'.__PACKAGE__.'::COMMAND_INSTALLER';
  56   return qq{BEGIN { ${name}->(__PACKAGE__) }\n}.$self->$orig(@_);
  57 };
  58
  59 around 'compile' => sub {
  60   my ($orig, $self) = (shift, shift);
  61   local $COMMAND_INSTALLER = $self->command_installer;
  62   $self->$orig(@_);
  63 };
  64
  65 1;
  66
  67 __END__
  68
  69 =head1 NAME
  70
  71 Devel::REPL::Plugin::Commands - Generic command creation plugin using injected functions
  72
  73 =cut
  74