.\" Automatically generated by Pod::Man 4.09 (Pod::Simple 3.35) .\" .\" Standard preamble: .\" ======================================================================== .de Sp \" Vertical space (when we can't use .PP) .if t .sp .5v .if n .sp .. .de Vb \" Begin verbatim text .ft CW .nf .ne \\$1 .. .de Ve \" End verbatim text .ft R .fi .. .\" Set up some character translations and predefined strings. \*(-- will .\" give an unbreakable dash, \*(PI will give pi, \*(L" will give a left .\" double quote, and \*(R" will give a right double quote. \*(C+ will .\" give a nicer C++. Capital omega is used to do unbreakable dashes and .\" therefore won't be available. \*(C` and \*(C' expand to `' in nroff, .\" nothing in troff, for use with C<>. .tr \(*W- .ds C+ C\v'-.1v'\h'-1p'\s-2+\h'-1p'+\s0\v'.1v'\h'-1p' .ie n \{\ . ds -- \(*W- . ds PI pi . if (\n(.H=4u)&(1m=24u) .ds -- \(*W\h'-12u'\(*W\h'-12u'-\" diablo 10 pitch . if (\n(.H=4u)&(1m=20u) .ds -- \(*W\h'-12u'\(*W\h'-8u'-\" diablo 12 pitch . ds L" "" . ds R" "" . ds C` "" . ds C' "" 'br\} .el\{\ . ds -- \|\(em\| . ds PI \(*p . ds L" `` . ds R" '' . ds C` . ds C' 'br\} .\" .\" Escape single quotes in literal strings from groff's Unicode transform. .ie \n(.g .ds Aq \(aq .el .ds Aq ' .\" .\" If the F register is >0, we'll generate index entries on stderr for .\" titles (.TH), headers (.SH), subsections (.SS), items (.Ip), and index .\" entries marked with X<> in POD. Of course, you'll have to process the .\" output yourself in some meaningful fashion. .\" .\" Avoid warning from groff about undefined register 'F'. .de IX .. .if !\nF .nr F 0 .if \nF>0 \{\ . de IX . tm Index:\\$1\t\\n%\t"\\$2" .. . if !\nF==2 \{\ . nr % 0 . nr F 2 . \} .\} .\" ======================================================================== .\" .IX Title "Monkey::Patch::Action 3pm" .TH Monkey::Patch::Action 3pm "2018-04-15" "perl v5.26.1" "User Contributed Perl Documentation" .\" For nroff, turn off justification. Always turn off hyphenation; it makes .\" way too many mistakes in technical documents. .if n .ad l .nh .SH "NAME" Monkey::Patch::Action \- Wrap/add/replace/delete subs from other package (with restore) .SH "VERSION" .IX Header "VERSION" This document describes version 0.061 of Monkey::Patch::Action (from Perl distribution Monkey-Patch-Action), released on 2018\-04\-02. .SH "SYNOPSIS" .IX Header "SYNOPSIS" Patching package or class: .PP .Vb 1 \& use Monkey::Patch::Action qw(patch_package); \& \& package Foo; \& sub sub1 { say "Foo\*(Aqs sub1" } \& sub sub2 { say "Foo\*(Aqs sub2, args=", join(",", @_) } \& sub meth1 { my $self = shift; say "Foo\*(Aqs 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(\*(AqFoo\*(Aq, \*(Aqsub1\*(Aq, \*(Aqreplace\*(Aq, sub { "qux" }); \& Foo::sub1(); # says "qux" \& undef $h; \& Foo::sub1(); # says "Foo\*(Aqs sub1" \& \& # adding a subroutine \& $h = patch_package(\*(AqFoo\*(Aq, \*(Aqsub3\*(Aq, \*(Aqadd\*(Aq, sub { "qux" }); \& Foo::sub3(); # says "qux" \& undef $h; \& Foo::sub3(); # dies \& \& # deleting a subroutine \& $h = patch_package(\*(AqFoo\*(Aq, \*(Aqsub2\*(Aq, \*(Aqdelete\*(Aq); \& Foo::sub2(); # dies \& undef $h; \& Foo::sub2(); # says "Foo\*(Aqs sub2, args=" \& \& # wrapping a subroutine \& $h = patch_package(\*(AqFoo\*(Aq, \*(Aqsub2\*(Aq, \*(Aqwrap\*(Aq, \& sub { \& my $ctx = shift; \& say "wrapping $ctx\->{package}::$ctx\->{subname}"; \& $ctx\->{orig}\->(@_); \& } \& ); \& Foo::sub2(1,2,3); # says "wrapping Foo::sub2" then "Foo\*(Aqs sub2, args=1,2,3" \& undef $h; \& Foo::sub2(1,2,3); # says "Foo\*(Aqs sub2, args=1,2,3" \& \& # stacking patches (note: can actually be unapplied in random order) \& my ($h2, $h3); \& $h = patch_package(\*(AqFoo\*(Aq, \*(Aqsub1\*(Aq, \*(Aqreplace\*(Aq, sub { "qux" }); \& Foo::sub1(); # says "qux" \& $h2 = patch_package(\*(AqFoo\*(Aq, \*(Aqsub1\*(Aq, \*(Aqdelete\*(Aq); \& Foo::sub1(); # dies \& $h3 = patch_package(\*(AqFoo\*(Aq, \*(Aqsub1\*(Aq, \*(Aqreplace\*(Aq, sub { "quux" }); \& Foo::sub1(); # says "quux" \& undef $h3; \& Foo::sub1(); # dies \& undef $h2; \& Foo::sub1(); # says "qux" \& undef $h; \& Foo::sub1(); # says "Foo\*(Aqs sub1" .Ve .PP Patching object: .PP .Vb 1 \& use Monkey::Patch::Action qw(patch_package); \& \& package Foo; \& sub meth1 { say "Foo\*(Aqs meth1" } \& \& package Bar; \& our @ISA = qw(Foo); \& sub meth2 { say "Bar\*(Aqs 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, \*(Aqmeth1\*(Aq, \*(Aqreplace\*(Aq, sub { say "Foo\*(Aqs modified meth1" }); \& $foo1\->meth1; # says "Foo\*(Aqs modified meth1" \& $foo2\->meth1; # says "Foo\*(Aqs meth1" \& undef $h; \& $foo1\->meth1; # says "Foo\*(Aqs meth1" \& \& $h = patch_object($bar1, \*(Aqmeth3\*(Aq, \*(Aqadd\*(Aq, sub { "Bar\*(Aqs meth3" }); \& $bar1\->meth3; # says "Bar\*(Aqs meth3" \& $bar2\->meth3; # dies \& undef $h; \& $bar1\->meth3; # dies \& \& # deleting a method \& $h = patch_object($foo1, \*(Aqmeth1\*(Aq, \*(Aqdelete\*(Aq); \& $foo1\->meth1; # dies \& $foo2\->meth1; # says "Foo\*(Aqs meth1" \& undef $h; \& $foo1\->meth1; # says "Foo\*(Aqs meth1" \& \& # wrapping a method \& $h = patch_object($foo1, \*(Aqmeth1\*(Aq, \*(Aqwrap\*(Aq, \& sub { \& my $ctx = shift; \& say "Wrapping $ctx\->{package}::$ctx\->{subname}"; \& $ctx\->{orig}\->(@_); \& } \& ); \& $foo1\->meth1; # says "Wrapping Foo::meth1" then "Foo\*(Aqs meth1" \& $foo2\->meth1; # says "Foo\*(Aqs meth1" \& undef $h; \& $foo1\->meth1; # says "Foo\*(Aqs meth1" .Ve .SH "DESCRIPTION" .IX Header "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: .PP .Vb 2 \& # add a subroutine \& *{"Target::sub1"} = sub { ... }; \& \& # another way, can be done from any file \& package Target; \& sub sub2 { ... } \& \& # delete a subroutine \& undef *{"Target::sub3"}; .Ve .PP This module makes things even easier by helping you apply a stack of patches and unapply them later in flexible order. .SH "FUNCTIONS" .IX Header "FUNCTIONS" .SS "patch_package" .IX Subsection "patch_package" Usage: .PP .Vb 1 \& patch_package($package, $subname, $action, $code, @extra) => HANDLE .Ve .PP Patch \f(CW$package\fR's subroutine named \f(CW$subname\fR. \f(CW$action\fR is either: .IP "\(bu" 4 \&\f(CW\*(C`wrap\*(C'\fR .Sp \&\f(CW$subname\fR must already exist. \f(CW\*(C`code\*(C'\fR is required. .Sp Your code receives a context hash as its first argument, followed by any arguments the subroutine would have normally gotten. Context hash contains: \&\f(CW\*(C`orig\*(C'\fR (the original subroutine that is being wrapped), \f(CW\*(C`subname\*(C'\fR, \f(CW\*(C`package\*(C'\fR, \&\f(CW\*(C`extra\*(C'\fR. .IP "\(bu" 4 \&\f(CW\*(C`add\*(C'\fR .Sp \&\f(CW\*(C`subname\*(C'\fR must not already exist. \f(CW\*(C`code\*(C'\fR is required. .IP "\(bu" 4 \&\f(CW\*(C`replace\*(C'\fR .Sp \&\f(CW\*(C`subname\*(C'\fR must already exist. \f(CW\*(C`code\*(C'\fR is required. .IP "\(bu" 4 \&\f(CW\*(C`add_or_replace\*(C'\fR .Sp \&\f(CW\*(C`code\*(C'\fR is required. .IP "\(bu" 4 \&\f(CW\*(C`delete\*(C'\fR .Sp \&\f(CW\*(C`code\*(C'\fR is not needed. .PP Die on error. .PP 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. .PP 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. .SS "patch_object" .IX Subsection "patch_object" Usage: .PP .Vb 1 \& patch_object($obj, $methname, $action, $code, @extra) => HANDLE .Ve .PP Basically just a wrapper for \f(CW\*(C`patch_package\*(C'\fR to patch \*(L"only specific object(s)\*(R". Basically it does something like this: .PP .Vb 6 \& die "\*(Aq$obj\*(Aq is not an object" unless blessed($obj); \& my $package = ref($obj); \& patch_package($package, $methname, \*(Aqwrap\*(Aq, \& sub { \& my $ctx = shift; \& my $self = shift; \& \& my $o = $ctx\->{extra}[0]; \& no warnings \*(Aqnumeric\*(Aq; \& if ($o == $self) { \& # do stuff \& } else { \& # not our target object \& $ctx\->{orig}\->(@_); \& } \& }, \& ); .Ve .SH "FAQ" .IX Header "FAQ" .SS "Differences with Monkey::Patch?" .IX Subsection "Differences with Monkey::Patch?" This module is based on the wonderful Monkey::Patch by Paul Driver. The differences are: .IP "\(bu" 4 This module adds the ability to add/replace/delete subroutines instead of just wrapping them. .IP "\(bu" 4 Interface to \fIpatch_package()\fR is slightly different (see previous item for the cause). .IP "\(bu" 4 Using this module, the wrapper receives a context hash instead of just the original subroutine. .IP "\(bu" 4 .SS "How to patch classes and objects?" .IX Subsection "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: .PP .Vb 1 \& $self\->SUPER::methname(...) .Ve .PP you need to do something like: .PP .Vb 2 \& use SUPER; \& SUPER::find_parent(ref($self), \*(Aqmethname\*(Aq)\->methname(...) .Ve .PP 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: .PP .Vb 4 \& patch_package($package, $methname, \*(Aqwrap\*(Aq, \& sub { \& my $ctx = shift; \& my $self = shift; \& \& my $obj = $ctx\->{extra}[0]; \& no warnings \*(Aqnumeric\*(Aq; \& if ($obj == $self) { \& # do stuff \& } \& $ctx\->{orig}\->(@_); \& }, $obj); .Ve .PP This is basically what \*(L"patch_object\*(R" does. .SH "HOMEPAGE" .IX Header "HOMEPAGE" Please visit the project's homepage at . .SH "SOURCE" .IX Header "SOURCE" Source repository is at . .SH "BUGS" .IX Header "BUGS" Please report any bugs or feature requests on the bugtracker website .PP 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. .SH "SEE ALSO" .IX Header "SEE ALSO" Monkey::Patch .SH "AUTHOR" .IX Header "AUTHOR" perlancar .SH "COPYRIGHT AND LICENSE" .IX Header "COPYRIGHT AND LICENSE" This software is copyright (c) 2018, 2017, 2012 by perlancar@cpan.org. .PP This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself.