X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDevel%2FGlobalDestruction.pm;h=25b895881e2cd4f7a12ce3e62f89283c53ea7962;hb=23135b02f4a06a25ad3626ca40d8c171b379f25f;hp=bb90dc7b92341d7acac4ffa71dcb2d7c28dec3c2;hpb=53e46d40959fe01fee57796f3acea6bac3b41449;p=p5sagit%2FDevel-GlobalDestruction.git diff --git a/lib/Devel/GlobalDestruction.pm b/lib/Devel/GlobalDestruction.pm index bb90dc7..25b8958 100644 --- a/lib/Devel/GlobalDestruction.pm +++ b/lib/Devel/GlobalDestruction.pm @@ -1,46 +1,60 @@ -#!/usr/bin/perl - package Devel::GlobalDestruction; use strict; use warnings; -use vars qw($VERSION); - -use XSLoader; - -$VERSION = '0.02'; - -XSLoader::load(__PACKAGE__, $VERSION); +our $VERSION = '0.09'; -use Sub::Exporter -setup => { - exports => [ qw(in_global_destruction) ], - groups => { default => [ -all ] }, +use Sub::Exporter::Progressive -setup => { + exports => [ qw(in_global_destruction) ], + groups => { default => [ -all ] }, }; -__PACKAGE__ +# we run 5.14+ - everything is in core +# +if (defined ${^GLOBAL_PHASE}) { + eval 'sub in_global_destruction () { ${^GLOBAL_PHASE} eq q[DESTRUCT] }; 1' + or die $@; +} +# try to load the xs version if it was compiled +# +elsif (eval { + require XSLoader; + XSLoader::load(__PACKAGE__, $VERSION); + 1; +}) { + # the eval already installed everything, nothing to do +} +else { + # internally, PL_main_start is nulled immediately before entering global destruction + # and we can use B to detect that + require B; + eval 'sub in_global_destruction () { B::main_start()->isa(q[B::NULL]) }; 1' + or die $@; +} + +1; # keep require happy -__END__ -=pod +__END__ =head1 NAME -Devel::GlobalDestruction - Expose PL_dirty, the flag which marks global +Devel::GlobalDestruction - Expose the flag which marks global destruction. =head1 SYNOPSIS - package Foo; - use Devel::GlobalDestruction; + package Foo; + use Devel::GlobalDestruction; - use namespace::clean; # to avoid having an "in_global_destruction" method + use namespace::clean; # to avoid having an "in_global_destruction" method - sub DESTROY { - return if in_global_destruction; + sub DESTROY { + return if in_global_destruction; - do_something_a_little_tricky(); - } + do_something_a_little_tricky(); + } =head1 DESCRIPTION @@ -56,32 +70,37 @@ destruction is in effect. =head1 EXPORTS -This module uses L so the exports may be renamed, aliased, etc. +This module uses L so the exports may be renamed, +aliased, etc. if L is present. =over 4 =item in_global_destruction -Returns the current value of C. +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. =back -=head1 VERSION CONTROL +=head1 AUTHORS -This module is maintained using Darcs. You can get the latest version from -L, and use C to commit -changes. +Yuval Kogman Enothingmuch@woobling.orgE -=head1 AUTHOR +Florian Ragwitz Erafl@debian.orgE -Yuval Kogman Enothingmuch@woobling.orgE +Jesse Luehrs Edoy@tozt.netE -=head1 COPYRIGHT +Peter Rabbitson Eribasushi@cpan.orgE - Copyright (c) 2008 Yuval Kogman. All rights reserved - This program is free software; you can redistribute - it and/or modify it under the same terms as Perl itself. +Arthur Axel 'fREW' Schmidt Efrioux@gmail.comE -=cut +Elizabeth Mattijsen Eliz@dijkmat.nlE +=head1 COPYRIGHT + + Copyright (c) 2008 Yuval Kogman. All rights reserved + This program is free software; you can redistribute + it and/or modify it under the same terms as Perl itself. +=cut