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

This file is indexed.

/usr/share/perl5/Monkey/Patch/Handle.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
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
package Monkey::Patch::Handle;
BEGIN {
  $Monkey::Patch::Handle::VERSION = '0.03';
}
use Scalar::Util qw(weaken);
use Sub::Delete;

use strict;
use warnings;

my %handles;

# What we're doing here, essentially, is keeping a stack of subroutine
# refs for each name (Foo::bar::baz type name).  We're doing this so that
# the coderef that lives at that name is always the top of the stack, so
# the wrappers get uninstalled in a funky order all hell doesn't break
# loose.  The most recently installed undestroyed wrapper will always get
# called, and it will unwind gracefully until we get down to the original
# sub (if there was one).

sub new {
    my ($class, %args) = @_;
    bless \%args, $class;
}

sub name {
    my $self = shift;
    $self->{name} ||= "$self->{package}::$self->{subname}";
}

sub stack {
    my $self = shift;
    $self->{stack} ||= $handles{ $self->name } ||= [];
}

sub call_previous {
    my $self    = shift;
    my $stack   = $self->stack;
    my $wrapper = $self->wrapper;
    for my $i (1..$#$stack) {
        if ($stack->[$i] == $wrapper) {
            goto &{ $stack->[$i-1] };
        }
    }
    $self->call_default(@_);
}

sub call_default {}

sub should_call_code { 1 }

sub wrapper {
    my $self = shift;
    unless ($self->{wrapper}) {
        weaken($self);
        $self->{wrapper} = sub {
            if ($self->should_call_code($_[0])) {
                unshift @_, sub { $self->call_previous(@_) };
                goto $self->{code};
            }
            else {
                return $self->call_previous(@_);
            }
        };
    }
    return $self->{wrapper};
}

sub install {
    my $self = shift;
    my $name  = $self->name;
    my $stack = $self->stack;

    no strict 'refs';

    unless (@$stack) {
        if (*$name{CODE}) {
            push @$stack, \&$name;
        }
    }

    my $code = $self->wrapper;

    no warnings 'redefine';
    *$name = $code;
    push(@$stack, $code);

    return $self;
}

sub DESTROY {
    my $self    = shift;
    my $stack   = $self->stack;
    my $wrapper = $self->wrapper;
    for my $i (0..$#$stack) {
        if($stack->[$i] == $wrapper) {
            splice @$stack, $i, 1;
            no strict 'refs';
            my $name = $self->name;
            if(my $top = $stack->[-1]) {
                no warnings 'redefine';
                *$name = $top;
            }
            else {
                delete_sub $name;
            }
            last;
        }
    }
}

1;

=head1 NAME

Monkey::Patch::Handle - Handle for monkey-patched functions

=head1 DESCRIPTION

Monkey::Patch::Handle keeps a stack of subroutine references for
each name (Foo::bar::baz type name), so that the coderef that lives
at that name is always the top of the stack, and if the wrappers get
uninstalled in a funky order all hell doesn't break loose.

You should never need to use this directly, so read L(Monkey::Patch)
instead.

=pod

=begin Pod::Coverage

.*

=end Pod::Coverage

APT Browse - Built by Thomas Orozco.