use strict;
use warnings;
-our $VERSION = '0.09';
+our $VERSION = '0.11';
use Sub::Exporter::Progressive -setup => {
exports => [ qw(in_global_destruction) ],
# try to load the xs version if it was compiled
#
elsif (eval {
- require XSLoader;
- XSLoader::load(__PACKAGE__, $VERSION);
+ require Devel::GlobalDestruction::XS;
+ no warnings 'once';
+ *in_global_destruction = \&Devel::GlobalDestruction::XS::in_global_destruction;
1;
}) {
# the eval already installed everything, nothing to do
}
-# We need pure-perl and we are running under -c
-# None of the END-block trickery will work, use a global scope guard instead,
-# as it is more than adequate in this situation
-# The whole thing is in an eval to prevent perl from parsing it in the
-# first place where none of this is needed
-#
-elsif ($^C) {
- eval <<'PP_IGD' or die $@;
-
- my $in_global_destruction;
-
- sub in_global_destruction () { $in_global_destruction }
-
- {
- package Devel::GlobalDestgruction::_MinusC::ScopeGuard;
- sub DESTROY { shift->[0]->() };
- }
-
- no warnings 'once';
- $Devel::GlobalDestgruction::_MinusC::guard = bless [sub {
- $in_global_destruction = 1;
- }], 'Devel::GlobalDestgruction::_MinusC::ScopeGuard';
-
- 1; # keep eval happy
-
-PP_IGD
-}
-# Not core nor XS
-# The whole thing is in an eval to prevent perl from parsing it in the
-# first place under perls where none of this is needed
-#
else {
- eval <<'PP_IGD' or die $@;
-
-# SpeedyCGI runs END blocks every cycle but somehow keeps object instances
-# hence DIAF
-die("The pure-perl version of @{[__PACKAGE__]} can not function correctly under CGI::SpeedyCGI. "
- . "Please ensure you have a working compiler, and reinstall @{[__PACKAGE__]} to enable the XS "
- . "codepath.\n"
-) if $CGI::SpeedyCGI::i_am_speedy;
-
-my ($in_global_destruction, $before_is_installed);
-
-sub in_global_destruction () { $in_global_destruction }
-
-# end_av trick suggested by liz++
-require B;
-my $add_endblock = sub {
- push @{ B::end_av()->object_2svref }, sub { $in_global_destruction = 1 };
-};
-
-# This block will fire towards the end of the program execution
-# Use it to inject an END block which is guaranteed to run last
-# (as long as something else doesn't inject yet another block in
-# the same manner afterwards, at which point it hardly matters
-# anyway)
-#
-END { $add_endblock->() }
-
-# threads do not execute the global ENDs (it would be stupid). However
-# one can register a new thread-local END from within a thread, and
-# achieve the same result. A logical place to do this would be CLONE, which
-# is claimed to run in the context of the new thread. However this does
-# not really seem to be the case - any END inserted in a CLONE is ignored :(
-# Hence blatantly hooking threads::create
-#
-if ($INC{'threads.pm'}) {
- require Scalar::Util;
-
- my $orig_create = threads->can('create');
- no warnings 'redefine';
-
- *threads::create = sub {
- my $class = shift;
- my $target = shift;
-
- unless ( (Scalar::Util::reftype($target)||'') eq 'CODE' ) {
- no strict 'refs';
- $target = \&{ caller() . "::$target" };
- }
-
- @_ = (
- $class,
- sub {
- # Perls compiled with THREADS_HAVE_PIDS do not copy end_av properly
- # between threads, so B::end_av ends up returning a B::SPECIAL and it
- # goes downhill from there
- # Install a noop END just to be on the safe side
- { local $@; eval 'END {}' }
- $add_endblock->();
- goto $target
- },
- @_,
- );
-
- goto $orig_create;
- };
-
- $before_is_installed = 1;
-}
-
-# just in case threads got loaded after us (silly)
-sub CLONE {
- unless ($before_is_installed) {
- require Carp;
- Carp::croak("You must load the 'threads' module before @{[ __PACKAGE__ ]}");
+ # internally, PL_main_start is nulled immediately before entering global destruction
+ # and we can use B to detect that. It will also be null before the main runloop starts,
+ # so we check install a CHECK if needed to detect that.
+ require B;
+ my $started = !B::main_start()->isa(q[B::NULL]);
+ unless ($started) {
+ # work around 5.6 eval bug
+ eval '0 && $started; CHECK { $started = 1 }; 1'
+ or die $@;
}
-}
-
-1; # keep eval happy
-
-PP_IGD
-
+ eval '0 && $started; sub in_global_destruction () { $started && B::main_start()->isa(q[B::NULL]) }; 1'
+ or die $@;
}
1; # keep require happy
=head1 NAME
-Devel::GlobalDestruction - Expose the flag which marks global
-destruction.
+Devel::GlobalDestruction - Provides function returning the equivalent of
+C<${^GLOBAL_PHASE} eq 'DESTRUCT'> for older perls.
=head1 SYNOPSIS
because it's not ordered and objects can sometimes disappear.
Writing defensive destructors is hard and annoying, and usually if global
-destruction is happenning you only need the destructors that free up non
+destruction is happening you only need the destructors that free up non
process local resources to actually execute.
For these constructors you can avoid the mess by simply bailing out if global
=item in_global_destruction
Returns true if the interpreter is in global destruction. In perl 5.14+, this
-returns C<${^GLOBAL_PHASE} eq 'DESTRUCT'>, and on earlier perls, it returns the
-current value of C<PL_dirty>.
+returns C<${^GLOBAL_PHASE} eq 'DESTRUCT'>, and on earlier perls, detects it using
+the value of C<PL_main_start> or C<PL_dirty>.
=back
Elizabeth Mattijsen E<lt>liz@dijkmat.nlE<gt>
+Greham Knop E<lt>haarg@haarg.orgE<gt>
+
=head1 COPYRIGHT
Copyright (c) 2008 Yuval Kogman. All rights reserved
projects / p5sagit/Devel-GlobalDestruction.git / blobdiff