This file is indexed.

/usr/share/perl5/Monkey/Patch.pm is in libmonkey-patch-perl 0.03-1.

This file is owned by root:root, with mode 0o644.

The actual contents of the file can be viewed below.

  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
package Monkey::Patch;
BEGIN {
  $Monkey::Patch::VERSION = '0.03';
}

use warnings;
use strict;

use Monkey::Patch::Handle;
use Monkey::Patch::Handle::Class;
use Monkey::Patch::Handle::Object;

use Exporter qw(import);
our @EXPORT_OK = qw(patch_package patch_class patch_object);
our %EXPORT_TAGS = (all => \@EXPORT_OK);

sub patch_package {
    Monkey::Patch::Handle->new(
        package => shift,
        subname => shift,
        code    => shift,
    )->install;
}

sub patch_class {
    Monkey::Patch::Handle::Class->new(
        package => shift,
        subname => shift,
        code    => shift,
    )->install;
}

sub patch_object {
    my $obj = shift;
    Monkey::Patch::Handle::Object->new(
        object  => $obj,
        package => ref $obj,
        subname => shift,
        code    => shift,
    )->install;
}

=head1 NAME

Monkey::Patch - Scoped monkeypatching (you can at least play nice)

=head1 VERSION

version 0.03

=head1 SYNOPSIS

    use Monkey::Patch qw(:all);

    sub some_subroutine {
        my $pkg = patch_class 'Some::Class' => 'something' => sub {
            my $original = shift;
            say "Whee!";
            $original->(@_);
        };
        Some::Class->something(); # says Whee! and does whatever
        undef $pkg;
        Some::Class->something(); # no longer says Whee! 

        my $obj = Some::Class->new;
        my $obj2 = Some::Class->new;

        my $whoah = patch_object $obj, 'twiddle' => sub {
            my $original = shift;
            my $self     = shift;
            say "Whoah!";
            $self->$original(@_);
        };

        $obj->twiddle();  # says Whoah!
        $obj2->twiddle(); # doesn't
        $obj->twiddle()   # still does
        undef $whoah;
        $obj->twiddle();  # but not any more
    
=head1 SUBROUTINES

The following subroutines are available (either individually or via :all)

=head2 patch_package (package, subname, code)

Wraps C<package>'s subroutine named <subname> with your <code>.  Your code
recieves the original subroutine as its first argument, followed by any
arguments the subroutine would have normally gotten.  You can always call the
subroutine ref your received; if there was no subroutine by that name, the
coderef will simply do nothing.

=head2 patch_class (class, methodname, code)

Just like C<patch_package>, except that the @ISA chain is walked when you try
to call the original subroutine if there wasn't any subroutine by that name in
the package.

=head2 patch_object (object, methodname, code)

Just like C<patch_class>, except that your code will only get called on the
object you pass, not the entire class.

=head1 HANDLES

All the C<patch> functions return 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 monkey patch is
unwrapped.  You can stack monkeypatches and let go of the handles in any
order; they obey a stack discipline, and the most recent valid monkeypatch
will always be called.  Calling the "original" argument to your wrapper
routine will always call the next-most-recent monkeypatched version (or, the
original subroutine, of course).

=head1 BUGS

This magic is only faintly black, but mucking around with the symbol table is
not for the faint of heart.  Help make this module better by reporting any
strange behavior that you see!