Commit | Line | Data |
1716b200 |
1 | use strict; |
2 | use warnings; |
4d33251a |
3 | package Devel::REPL::Plugin::Commands; |
9d2a4940 |
4 | # ABSTRACT: Generic command creation plugin using injected functions |
4d33251a |
5 | |
c45376f3 |
6 | our $VERSION = '1.003029'; |
54beb05d |
7 | |
4d33251a |
8 | use Devel::REPL::Plugin; |
9 | use Scalar::Util qw(weaken); |
aa8b7647 |
10 | use namespace::autoclean; |
1d6c2dbc |
11 | |
28e93f31 |
12 | our $COMMAND_INSTALLER; |
4d33251a |
13 | |
14 | has 'command_set' => ( |
b595a818 |
15 | is => 'ro', |
4d33251a |
16 | lazy => 1, default => sub { {} } |
17 | ); |
18 | |
19 | sub BEFORE_PLUGIN { |
20 | my ($self) = @_; |
deda07fb |
21 | $self->load_plugin('Packages'); |
4d33251a |
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); |
6edfdc07 |
35 | $self->command_set->{load_plugin} = sub { |
36 | my $self = shift; |
37 | sub { $self->load_plugin(@_); }; |
38 | }; |
4d33251a |
39 | }; |
40 | |
41 | sub command_installer { |
42 | my ($self) = @_; |
6edfdc07 |
43 | my $command_set = $self->command_set; |
44 | my %command_subs = map { |
45 | ($_ => $command_set->{$_}->($self)); |
46 | } keys %$command_set; |
4d33251a |
47 | return sub { |
48 | my $package = shift; |
6edfdc07 |
49 | foreach my $command (keys %command_subs) { |
4d33251a |
50 | no strict 'refs'; |
51 | no warnings 'redefine'; |
6edfdc07 |
52 | *{"${package}::${command}"} = $command_subs{$command}; |
4d33251a |
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; |