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