lib/Devel/REPL/Plugin/Commands.pm

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