xref: /openbsd-src/gnu/usr.bin/perl/cpan/autodie/lib/autodie/Scope/GuardStack.pm (revision 3d61058aa5c692477b6d18acfbbdb653a9930ff9) 
1package autodie::Scope::GuardStack;
2
3use strict;
4use warnings;
5
6use autodie::Scope::Guard;
7
8# ABSTRACT: Hook stack for managing scopes via %^H
9our $VERSION = '2.37'; # VERSION
10
11my $H_KEY_STEM = __PACKAGE__ . '/guard';
12my $COUNTER = 0;
13
14# This code schedules the cleanup of subroutines at the end of
15# scope.  It's directly inspired by chocolateboy's excellent
16# Scope::Guard module.
17
18sub new {
19    my ($class) = @_;
20
21    return bless([], $class);
22}
23
24sub push_hook {
25    my ($self, $hook) = @_;
26    my $h_key = $H_KEY_STEM . ($COUNTER++);
27    my $size = @{$self};
28    $^H{$h_key} = autodie::Scope::Guard->new(sub {
29        # Pop the stack until we reach the right size
30        # - this may seem weird, but it is to avoid relying
31        #   on "destruction order" of keys in %^H.
32        #
33        # Example:
34        #  {
35        #     use autodie;  # hook 1
36        #     no autodie;   # hook 2
37        #     use autodie;  # hook 3
38        #  }
39        #
40        #  Here we want call hook 3, then hook 2 and finally hook 1.
41        #  Any other order could have undesired consequences.
42        #
43        #  Suppose hook 2 is destroyed first, it will pop hook 3 and
44        #  then hook 2.  hook 3 will then be destroyed, but do nothing
45        #  since its "frame" was already popped and finally hook 1
46        #  will be popped and take its own frame with it.
47        #
48        #  We need to check that $self still exists since things can get weird
49        #  during global destruction.
50        $self->_pop_hook while $self && @{$self} > $size;
51    });
52    push(@{$self}, [$hook, $h_key]);
53    return;
54}
55
56sub _pop_hook {
57    my ($self) = @_;
58    my ($hook, $key) = @{ pop(@{$self}) };
59    my $ref = delete($^H{$key});
60    $hook->();
61    return;
62}
63
64sub DESTROY {
65    my ($self) = @_;
66
67    # To be honest, I suspect @{$self} will always be empty here due
68    # to the subs in %^H having references to the stack (which would
69    # keep the stack alive until those have been destroyed).  Anyhow,
70    # it never hurt to be careful.
71    $self->_pop_hook while @{$self};
72    return;
73}
74
751;
76
77__END__
78
79=head1 NAME
80
81autodie::Scope::GuardStack -  Hook stack for managing scopes via %^H
82
83=head1 SYNOPSIS
84
85    use autodie::Scope::GuardStack;
86    my $stack = autodie::Scope::GuardStack->new
87    $^H{'my-key'} = $stack;
88
89    $stack->push_hook(sub {});
90
91=head1 DESCRIPTION
92
93This class is a stack of hooks to be called in the right order as
94scopes go away.  The stack is only useful when inserted into C<%^H>
95and will pop hooks as their "scope" is popped.  This is useful for
96uninstalling or reinstalling subs in a namespace as a pragma goes
97out of scope.
98
99Due to how C<%^H> works, this class is only useful during the
100compilation phase of a perl module and relies on the internals of how
101perl handles references in C<%^H>.  This module is not a part of
102autodie's public API.
103
104=head2 Methods
105
106=head3 new
107
108  my $stack = autodie::Scope::GuardStack->new;
109
110Creates a new C<autodie::Scope::GuardStack>.  The stack is initially
111empty and must be inserted into C<%^H> by the creator.
112
113=head3 push_hook
114
115  $stack->push_hook(sub {});
116
117Add a sub to the stack.  The sub will be called once the current
118compile-time "scope" is left.  Multiple hooks can be added per scope
119
120=head1 AUTHOR
121
122Copyright 2013, Niels Thykier E<lt>niels@thykier.netE<gt>
123
124=head1 LICENSE
125
126This module is free software.  You may distribute it under the
127same terms as Perl itself.
128