line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package KelpX::Hooks; |
2
|
|
|
|
|
|
|
|
3
|
1
|
|
|
1
|
|
101787
|
use strict; |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
30
|
|
4
|
1
|
|
|
1
|
|
5
|
use warnings; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
28
|
|
5
|
1
|
|
|
1
|
|
5
|
use Exporter qw(import); |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
42
|
|
6
|
1
|
|
|
1
|
|
6
|
use Carp qw(croak); |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
152
|
|
7
|
|
|
|
|
|
|
|
8
|
|
|
|
|
|
|
our @EXPORT = qw( |
9
|
|
|
|
|
|
|
hook |
10
|
|
|
|
|
|
|
); |
11
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
our $VERSION = '1.00'; |
13
|
|
|
|
|
|
|
|
14
|
|
|
|
|
|
|
sub hook |
15
|
|
|
|
|
|
|
{ |
16
|
3
|
|
|
3
|
1
|
145
|
my ($subname, $decorator) = @_; |
17
|
3
|
|
|
|
|
7
|
my ($package) = caller; |
18
|
|
|
|
|
|
|
|
19
|
3
|
|
|
|
|
38
|
my $build_method = $package->can("build"); |
20
|
3
|
50
|
|
|
|
9
|
croak "Can't hook $subname: no build() method in $package" |
21
|
|
|
|
|
|
|
unless defined $build_method; |
22
|
|
|
|
|
|
|
|
23
|
1
|
|
|
1
|
|
8
|
no strict 'refs'; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
62
|
|
24
|
1
|
|
|
1
|
|
15
|
no warnings 'redefine'; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
247
|
|
25
|
|
|
|
|
|
|
|
26
|
3
|
|
|
|
|
10
|
*{"${package}::build"} = sub { |
27
|
3
|
|
|
3
|
|
47831
|
my $self = shift; |
28
|
|
|
|
|
|
|
|
29
|
3
|
|
|
|
|
19
|
my $hooked_method = $package->can($subname); |
30
|
3
|
100
|
|
|
|
211
|
croak "Trying to hook $subname, which doesn't exist" |
31
|
|
|
|
|
|
|
unless defined $hooked_method; |
32
|
|
|
|
|
|
|
|
33
|
2
|
|
|
|
|
11
|
*{"${package}::$subname"} = sub { |
34
|
2
|
|
|
2
|
|
21
|
my ($kelp, @args) = @_; |
35
|
|
|
|
|
|
|
|
36
|
|
|
|
|
|
|
return wantarray ? |
37
|
2
|
50
|
|
|
|
11
|
$decorator->($hooked_method, $kelp, @args) : |
38
|
|
|
|
|
|
|
scalar $decorator->($hooked_method, $kelp, @args); |
39
|
2
|
|
|
|
|
8
|
}; |
40
|
|
|
|
|
|
|
|
41
|
|
|
|
|
|
|
return wantarray ? |
42
|
2
|
50
|
|
|
|
10
|
$self->$build_method(@_) : |
43
|
|
|
|
|
|
|
scalar $self->$build_method(@_); |
44
|
3
|
|
|
|
|
12
|
}; |
45
|
3
|
|
|
|
|
8
|
return; |
46
|
|
|
|
|
|
|
} |
47
|
|
|
|
|
|
|
|
48
|
|
|
|
|
|
|
|
49
|
|
|
|
|
|
|
1; |
50
|
|
|
|
|
|
|
__END__ |
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 C<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 SEE ALSO |
90
|
|
|
|
|
|
|
|
91
|
|
|
|
|
|
|
L<Kelp>, L<Moose::Manual::MethodModifiers> |
92
|
|
|
|
|
|
|
|
93
|
|
|
|
|
|
|
=head1 AUTHOR |
94
|
|
|
|
|
|
|
|
95
|
|
|
|
|
|
|
Bartosz Jarzyna, E<lt>brtastic.dev@gmail.comE<gt> |
96
|
|
|
|
|
|
|
|
97
|
|
|
|
|
|
|
=head1 COPYRIGHT AND LICENSE |
98
|
|
|
|
|
|
|
|
99
|
|
|
|
|
|
|
Copyright (C) 2020 by Bartosz Jarzyna |
100
|
|
|
|
|
|
|
|
101
|
|
|
|
|
|
|
This library is free software; you can redistribute it and/or modify |
102
|
|
|
|
|
|
|
it under the same terms as Perl itself, either Perl version 5.10.1 or, |
103
|
|
|
|
|
|
|
at your option, any later version of Perl 5 you may have available. |
104
|
|
|
|
|
|
|
|
105
|
|
|
|
|
|
|
|
106
|
|
|
|
|
|
|
=cut |