lib/Devel/GlobalDestruction.pm

   1 package Devel::GlobalDestruction;
   2
   3 use strict;
   4 use warnings;
   5
   6 our $VERSION = '0.11';
   7
   8 use Sub::Exporter::Progressive -setup => {
   9   exports => [ qw(in_global_destruction) ],
  10   groups  => { default => [ -all ] },
  11 };
  12
  13 # we run 5.14+ - everything is in core
  14 #
  15 if (defined ${^GLOBAL_PHASE}) {
  16   eval 'sub in_global_destruction () { ${^GLOBAL_PHASE} eq q[DESTRUCT] }; 1'
  17     or die $@;
  18 }
  19 # try to load the xs version if it was compiled
  20 #
  21 elsif (eval {
  22   require Devel::GlobalDestruction::XS;
  23   no warnings 'once';
  24   *in_global_destruction = \&Devel::GlobalDestruction::XS::in_global_destruction;
  25   1;
  26 }) {
  27   # the eval already installed everything, nothing to do
  28 }
  29 else {
  30   # internally, PL_main_start is nulled immediately before entering global destruction
  31   # and we can use B to detect that.  It will also be null before the main runloop starts,
  32   # so we check install a CHECK if needed to detect that.
  33   require B;
  34   my $started = !B::main_start()->isa(q[B::NULL]);
  35   unless ($started) {
  36     # work around 5.6 eval bug
  37     eval '0 && $started; CHECK { $started = 1 }; 1'
  38       or die $@;
  39   }
  40   eval '0 && $started; sub in_global_destruction () { $started && B::main_start()->isa(q[B::NULL]) }; 1'
  41     or die $@;
  42 }
  43
  44 1;  # keep require happy
  45
  46
  47 __END__
  48
  49 =head1 NAME
  50
  51 Devel::GlobalDestruction - Provides function returning the equivalent of
  52 C<${^GLOBAL_PHASE} eq 'DESTRUCT'> for older perls.
  53
  54 =head1 SYNOPSIS
  55
  56     package Foo;
  57     use Devel::GlobalDestruction;
  58
  59     use namespace::clean; # to avoid having an "in_global_destruction" method
  60
  61     sub DESTROY {
  62         return if in_global_destruction;
  63
  64         do_something_a_little_tricky();
  65     }
  66
  67 =head1 DESCRIPTION
  68
  69 Perl's global destruction is a little tricky to deal with WRT finalizers
  70 because it's not ordered and objects can sometimes disappear.
  71
  72 Writing defensive destructors is hard and annoying, and usually if global
  73 destruction is happening you only need the destructors that free up non
  74 process local resources to actually execute.
  75
  76 For these constructors you can avoid the mess by simply bailing out if global
  77 destruction is in effect.
  78
  79 =head1 EXPORTS
  80
  81 This module uses L<Sub::Exporter::Progressive> so the exports may be renamed,
  82 aliased, etc. if L<Sub::Exporter> is present.
  83
  84 =over 4
  85
  86 =item in_global_destruction
  87
  88 Returns true if the interpreter is in global destruction. In perl 5.14+, this
  89 returns C<${^GLOBAL_PHASE} eq 'DESTRUCT'>, and on earlier perls, detects it using
  90 the value of C<PL_main_start> or C<PL_dirty>.
  91
  92 =back
  93
  94 =head1 AUTHORS
  95
  96 Yuval Kogman E<lt>nothingmuch@woobling.orgE<gt>
  97
  98 Florian Ragwitz E<lt>rafl@debian.orgE<gt>
  99
 100 Jesse Luehrs E<lt>doy@tozt.netE<gt>
 101
 102 Peter Rabbitson E<lt>ribasushi@cpan.orgE<gt>
 103
 104 Arthur Axel 'fREW' Schmidt E<lt>frioux@gmail.comE<gt>
 105
 106 Elizabeth Mattijsen E<lt>liz@dijkmat.nlE<gt>
 107
 108 Greham Knop E<lt>haarg@haarg.orgE<gt>
 109
 110 =head1 COPYRIGHT
 111
 112     Copyright (c) 2008 Yuval Kogman. All rights reserved
 113     This program is free software; you can redistribute
 114     it and/or modify it under the same terms as Perl itself.
 115
 116 =cut