lib/Devel/REPL/Plugin/Commands.pm

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