File Coverage

blib/lib/Devel/REPL/Plugin/Commands.pm
Criterion Covered Total %
statement 27 36 75.0
branch 1 2 50.0
condition n/a
subroutine 11 13 84.6
pod 0 3 0.0
total 39 54 72.2


line stmt bran cond sub pod time code
1 2     2   2670 use strict;
  2         3  
  2         64  
2 2     2   7 use warnings;
  2         2  
  2         134  
3             package Devel::REPL::Plugin::Commands;
4             # ABSTRACT: Generic command creation plugin using injected functions
5              
6             our $VERSION = '1.003027';
7              
8 2     2   11 use Devel::REPL::Plugin;
  2         3  
  2         22  
9 2     2   7480 use Scalar::Util qw(weaken);
  2         4  
  2         119  
10 2     2   8 use namespace::autoclean;
  2         3  
  2         18  
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 1     1 0 2 my ($self) = @_;
21 1         5 $self->load_plugin('Packages');
22 1 50       70 unless ($self->can('setup_commands')) {
23 1     1   5 $self->meta->add_method('setup_commands' => sub {});
        1      
24             }
25             }
26              
27             sub AFTER_PLUGIN {
28 1     1 0 4 my ($self) = @_;
29 1         5 $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 0     0 0   my ($self) = @_;
43 0           my $command_set = $self->command_set;
44             my %command_subs = map {
45 0           ($_ => $command_set->{$_}->($self));
  0            
46             } keys %$command_set;
47             return sub {
48 0     0     my $package = shift;
49 0           foreach my $command (keys %command_subs) {
50 2     2   548 no strict 'refs';
  2         4  
  2         63  
51 2     2   6 no warnings 'redefine';
  2         3  
  2         377  
52 0           *{"${package}::${command}"} = $command_subs{$command};
  0            
53             }
54 0           };
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;
71              
72             __END__
73              
74             =pod
75              
76             =encoding UTF-8
77              
78             =head1 NAME
79              
80             Devel::REPL::Plugin::Commands - Generic command creation plugin using injected functions
81              
82             =head1 VERSION
83              
84             version 1.003027
85              
86             =head1 AUTHOR
87              
88             Matt S Trout - mst (at) shadowcatsystems.co.uk (L<http://www.shadowcatsystems.co.uk/>)
89              
90             =head1 COPYRIGHT AND LICENSE
91              
92             This software is copyright (c) 2007 by Matt S Trout - mst (at) shadowcatsystems.co.uk (L<http://www.shadowcatsystems.co.uk/>).
93              
94             This is free software; you can redistribute it and/or modify it under
95             the same terms as the Perl 5 programming language system itself.
96              
97             =cut