1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287
|
NAME
Monkey::Patch::Action - Wrap/add/replace/delete subs from other package
(with restore)
VERSION
This document describes version 0.061 of Monkey::Patch::Action (from
Perl distribution Monkey-Patch-Action), released on 2018-04-02.
SYNOPSIS
Patching package or class:
use Monkey::Patch::Action qw(patch_package);
package Foo;
sub sub1 { say "Foo's sub1" }
sub sub2 { say "Foo's sub2, args=", join(",", @_) }
sub meth1 { my $self = shift; say "Foo's meth1" }
package Bar;
our @ISA = qw(Foo);
package main;
my $h; # handle object
my $foo = Foo->new;
my $bar = Bar->new;
# replacing a subroutine
$h = patch_package('Foo', 'sub1', 'replace', sub { "qux" });
Foo::sub1(); # says "qux"
undef $h;
Foo::sub1(); # says "Foo's sub1"
# adding a subroutine
$h = patch_package('Foo', 'sub3', 'add', sub { "qux" });
Foo::sub3(); # says "qux"
undef $h;
Foo::sub3(); # dies
# deleting a subroutine
$h = patch_package('Foo', 'sub2', 'delete');
Foo::sub2(); # dies
undef $h;
Foo::sub2(); # says "Foo's sub2, args="
# wrapping a subroutine
$h = patch_package('Foo', 'sub2', 'wrap',
sub {
my $ctx = shift;
say "wrapping $ctx->{package}::$ctx->{subname}";
$ctx->{orig}->(@_);
}
);
Foo::sub2(1,2,3); # says "wrapping Foo::sub2" then "Foo's sub2, args=1,2,3"
undef $h;
Foo::sub2(1,2,3); # says "Foo's sub2, args=1,2,3"
# stacking patches (note: can actually be unapplied in random order)
my ($h2, $h3);
$h = patch_package('Foo', 'sub1', 'replace', sub { "qux" });
Foo::sub1(); # says "qux"
$h2 = patch_package('Foo', 'sub1', 'delete');
Foo::sub1(); # dies
$h3 = patch_package('Foo', 'sub1', 'replace', sub { "quux" });
Foo::sub1(); # says "quux"
undef $h3;
Foo::sub1(); # dies
undef $h2;
Foo::sub1(); # says "qux"
undef $h;
Foo::sub1(); # says "Foo's sub1"
Patching object:
use Monkey::Patch::Action qw(patch_package);
package Foo;
sub meth1 { say "Foo's meth1" }
package Bar;
our @ISA = qw(Foo);
sub meth2 { say "Bar's meth2" }
package main;
my $h; # handle object
my $foo1 = Foo->new;
my $foo2 = Foo->new;
my $bar1 = Bar->new;
my $bar2 = Bar->new;
# replacing a method
$h = patch_object($foo1, 'meth1', 'replace', sub { say "Foo's modified meth1" });
$foo1->meth1; # says "Foo's modified meth1"
$foo2->meth1; # says "Foo's meth1"
undef $h;
$foo1->meth1; # says "Foo's meth1"
$h = patch_object($bar1, 'meth3', 'add', sub { "Bar's meth3" });
$bar1->meth3; # says "Bar's meth3"
$bar2->meth3; # dies
undef $h;
$bar1->meth3; # dies
# deleting a method
$h = patch_object($foo1, 'meth1', 'delete');
$foo1->meth1; # dies
$foo2->meth1; # says "Foo's meth1"
undef $h;
$foo1->meth1; # says "Foo's meth1"
# wrapping a method
$h = patch_object($foo1, 'meth1', 'wrap',
sub {
my $ctx = shift;
say "Wrapping $ctx->{package}::$ctx->{subname}";
$ctx->{orig}->(@_);
}
);
$foo1->meth1; # says "Wrapping Foo::meth1" then "Foo's meth1"
$foo2->meth1; # says "Foo's meth1"
undef $h;
$foo1->meth1; # says "Foo's meth1"
DESCRIPTION
Monkey-patching is the act of modifying a package at runtime: adding a
subroutine/method, replacing/deleting/wrapping another, etc. Perl makes
it easy to do that, for example:
# add a subroutine
*{"Target::sub1"} = sub { ... };
# another way, can be done from any file
package Target;
sub sub2 { ... }
# delete a subroutine
undef *{"Target::sub3"};
This module makes things even easier by helping you apply a stack of
patches and unapply them later in flexible order.
FUNCTIONS
patch_package
Usage:
patch_package($package, $subname, $action, $code, @extra) => HANDLE
Patch $package's subroutine named $subname. $action is either:
* "wrap"
$subname must already exist. "code" is required.
Your code receives a context hash as its first argument, followed by
any arguments the subroutine would have normally gotten. Context
hash contains: "orig" (the original subroutine that is being
wrapped), "subname", "package", "extra".
* "add"
"subname" must not already exist. "code" is required.
* "replace"
"subname" must already exist. "code" is required.
* "add_or_replace"
"code" is required.
* "delete"
"code" is not needed.
Die on error.
Function returns a handle object. As soon as you lose the value of the
handle (by calling in void context, assigning over the variable,
undeffing the variable, letting it go out of scope, etc), the patch is
unapplied.
Patches can be unapplied in random order, but unapplying a patch where
the next patch is a wrapper can lead to an error. Example: first patch
(P1) adds a subroutine and second patch (P2) wraps it. If P1 is
unapplied before P2, the subroutine is now no longer there, and P2 no
longer works. Unapplying P1 after P2 works, of course.
patch_object
Usage:
patch_object($obj, $methname, $action, $code, @extra) => HANDLE
Basically just a wrapper for "patch_package" to patch "only specific
object(s)". Basically it does something like this:
die "'$obj' is not an object" unless blessed($obj);
my $package = ref($obj);
patch_package($package, $methname, 'wrap',
sub {
my $ctx = shift;
my $self = shift;
my $o = $ctx->{extra}[0];
no warnings 'numeric';
if ($o == $self) {
# do stuff
} else {
# not our target object
$ctx->{orig}->(@_);
}
},
);
FAQ
Differences with Monkey::Patch?
This module is based on the wonderful Monkey::Patch by Paul Driver. The
differences are:
* This module adds the ability to add/replace/delete subroutines
instead of just wrapping them.
* Interface to patch_package() is slightly different (see previous
item for the cause).
* Using this module, the wrapper receives a context hash instead of
just the original subroutine.
*
How to patch classes and objects?
Patching a class is basically the same as patching any other package,
since Perl implements a class with a package. One thing to note is that
to call a parent's method inside your wrapper code, instead of:
$self->SUPER::methname(...)
you need to do something like:
use SUPER;
SUPER::find_parent(ref($self), 'methname')->methname(...)
Patching an object is also basically patching a class/package, because
Perl does not have per-object method like Ruby. But if you just want to
provide a modified behavior for a certain object only, you can do
something like:
patch_package($package, $methname, 'wrap',
sub {
my $ctx = shift;
my $self = shift;
my $obj = $ctx->{extra}[0];
no warnings 'numeric';
if ($obj == $self) {
# do stuff
}
$ctx->{orig}->(@_);
}, $obj);
This is basically what "patch_object" does.
HOMEPAGE
Please visit the project's homepage at
<https://metacpan.org/release/Monkey-Patch-Action>.
SOURCE
Source repository is at
<https://github.com/perlancar/perl-Monkey-Patch-Action>.
BUGS
Please report any bugs or feature requests on the bugtracker website
<https://rt.cpan.org/Public/Dist/Display.html?Name=Monkey-Patch-Action>
When submitting a bug or request, please include a test-file or a patch
to an existing test-file that illustrates the bug or desired feature.
SEE ALSO
Monkey::Patch
AUTHOR
perlancar <perlancar@cpan.org>
COPYRIGHT AND LICENSE
This software is copyright (c) 2018, 2017, 2012 by perlancar@cpan.org.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
|