File Coverage

blib/lib/KelpX/Hooks.pm
Criterion Covered Total %
statement 36 36 100.0
branch 7 8 87.5
condition n/a
subroutine 10 10 100.0
pod 1 1 100.0
total 54 55 98.1


line stmt bran cond sub pod time code
1             $KelpX::Hooks::VERSION = '1.02';
2             use v5.10;
3 2     2   230175 use strict;
  2         10  
4 2     2   9 use warnings;
  2         4  
  2         46  
5 2     2   8  
  2         4  
  2         46  
6             use Exporter qw(import);
7 2     2   18 use Carp qw(croak);
  2         3  
  2         63  
8 2     2   10  
  2         10  
  2         260  
9             our @EXPORT = qw(
10             hook
11             );
12              
13             {
14             my ($subname, $decorator) = @_;
15             my $package = caller;
16 6     6 1 946  
17 6         12 croak "Hooking build() method is forbidden"
18             if $subname eq "build";
19 6 100       186  
20             my $build_method = $package->can("build");
21             croak "Can't hook $subname: no build() method in $package"
22 5         34 unless defined $build_method;
23 5 100       89  
24             no strict 'refs';
25             no warnings 'redefine';
26 2     2   13  
  2         4  
  2         67  
27 2     2   17 *{"${package}::build"} = sub {
  2         3  
  2         387  
28             my ($self) = @_;
29 4         11  
30 4     4   41552 my $hooked_method = $package->can($subname);
31             croak "Trying to hook $subname, which doesn't exist"
32 4         20 unless defined $hooked_method;
33 4 100       191  
34             *{"${package}::$subname"} = sub {
35             my ($kelp, @args) = @_;
36 3         10  
37 4     4   1596 return wantarray
38             ?
39             $decorator->($hooked_method, $kelp, @args)
40             :
41 4 50       17 scalar $decorator->($hooked_method, $kelp, @args);
42             };
43              
44 3         11 goto $build_method;
45             };
46 3         10 return;
47 4         11 }
48 4         10  
49             1;
50              
51              
52             =head1 NAME
53              
54             KelpX::Hooks - Override any method in your Kelp application
55              
56             =head1 SYNOPSIS
57              
58             # in your Kelp application
59             use KelpX::Hooks;
60              
61             # and then...
62             hook "template" => sub {
63             return "No templates for you!";
64             };
65              
66             =head1 DESCRIPTION
67              
68             This module allows you to override methods in your Kelp application class. The provided L</hook> method can be compared to Moose's C<around>, and it mimics its interface. The difference is in how and when the replacement of the actual method occurs.
69              
70             The problem here is that Kelp's modules are modifying the symbol table for the module at the runtime, which makes common attempts to change their methods` behavior futile. You can't override them, you can't change them with method modifiers, you can only replace them with different methods.
71              
72             This module fights the symbol table magic with more symbol table magic. It will replace any method with your anonymous subroutine after the application is built and all the modules have been loaded.
73              
74             =head2 EXPORT
75              
76             =head3 hook
77              
78             hook "sub_name" => sub {
79             my ($original_sub, $self, @arguments) = @_;
80              
81             # your code, preferably do this at some point:
82             return $self->$original_sub(@arguments);
83             };
84              
85             Allows you to provide your own subroutine in place of the one specified. The first argument is the subroutine that's being replaced. It won't be run at all unless you call it explicitly.
86              
87             Please note that Kelp::Less is not supported.
88              
89             =head1 CAVEATS
90              
91             This module works by replacing the build method in symbol tables. Because of this, you cannot hook the build method itself.
92              
93             =head1 SEE ALSO
94              
95             L<Kelp>, L<Moose::Manual::MethodModifiers>
96              
97             =head1 AUTHOR
98              
99             Bartosz Jarzyna, E<lt>bbrtj.pro@gmail.comE<gt>
100              
101             =head1 COPYRIGHT AND LICENSE
102              
103             Copyright (C) 2020 - 2022 by Bartosz Jarzyna
104              
105             This library is free software; you can redistribute it and/or modify
106             it under the same terms as Perl itself.
107              
108              
109             =cut
110