[libclass-tiny-perl] 04/19: pass global destruction flag to DEMOLISH methods

[gregor herrmann]

This is an automated email from the git hooks/post-receive script.

gregoa pushed a commit to annotated tag release-0.004
in repository libclass-tiny-perl.

commit ca4de78f916379e6043707eb13156626ac601cee
Author: David Golden <dagolden at cpan.org>
Date:   Tue Aug 20 16:52:25 2013 -0400

    pass global destruction flag to DEMOLISH methods
---
 README.pod        |  7 ++++---
 dist.ini          |  6 +++++-
 lib/Class/Tiny.pm | 23 ++++++++++++++++++-----
 3 files changed, 27 insertions(+), 9 deletions(-)

diff --git a/README.pod b/README.pod
index c3eb8bb..79f082d 100644
--- a/README.pod
+++ b/README.pod
@@ -198,11 +198,12 @@ ignored.  Use them for validation or setting default values.
 
 Class::Tiny provides a C<DESTROY> method.  If your class or any superclass
 defines a C<DEMOLISH> method, they will be called from the child class to the
-furthest parent class during object destruction.  No arguments are provided.
-Return values and errors are ignored.
+furthest parent class during object destruction.  It is provided a single
+boolean argument indicating whether Perl is in global destruction.  Return
+values and errors are ignored.
 
     sub DEMOLISH {
-        my $self = shift;
+        my ($self, $global_destruct) = @_;
         $self->cleanup();
     }
 
diff --git a/dist.ini b/dist.ini
index d801318..9f71b02 100644
--- a/dist.ini
+++ b/dist.ini
@@ -11,8 +11,9 @@ AutoMetaResources.bugtracker.github = user:dagolden
 stopwords = destructor
 
 [RemovePrereqs]
-remove = Test::FailWarnings
+remove = Devel::GlobalDestruction
 remove = MRO::Compat
+remove = Test::FailWarnings
 remove = mro
 
 [Prereqs / TestRecommends ]
@@ -21,6 +22,9 @@ Test::FailWarnings = 0
 [PerlVersionPrereqs / 5.010]
 MRO::Compat = 0
 
+[PerlVersionPrereqs / 5.014]
+Devel::GlobalDestruction = 0
+
 [OnlyCorePrereqs]
 :version = 0.003
 starting_version = current
diff --git a/lib/Class/Tiny.pm b/lib/Class/Tiny.pm
index cf41441..4089da5 100644
--- a/lib/Class/Tiny.pm
+++ b/lib/Class/Tiny.pm
@@ -86,7 +86,19 @@ sub new {
     return $self;
 }
 
-# Adapted from Moo
+
+# Adapted from Moo and its dependencies
+
+BEGIN {
+    if ( defined ${^GLOBAL_PHASE} ) {
+        *_in_global_destruction = sub { return ${^GLOBAL_PHASE} eq 'DESTRUCT' }
+    }
+    else {
+        require Devel::GlobalDestruction;
+        *_in_global_destruction = \&Devel::GlobalDestruction::in_global_destrucution;
+    }
+}
+
 sub DESTROY {
     my $self = shift;
 
@@ -96,7 +108,7 @@ sub DESTROY {
         my $e          = do {
             local $?;
             local $@;
-            eval { $self->$demolisher if defined $demolisher };
+            eval { $self->$demolisher(_in_global_destruction()) if defined $demolisher };
             $@;
         };
         no warnings 'misc'; # avoid (in cleanup) warnings
@@ -265,11 +277,12 @@ ignored.  Use them for validation or setting default values.
 
 Class::Tiny provides a C<DESTROY> method.  If your class or any superclass
 defines a C<DEMOLISH> method, they will be called from the child class to the
-furthest parent class during object destruction.  No arguments are provided.
-Return values and errors are ignored.
+furthest parent class during object destruction.  It is provided a single
+boolean argument indicating whether Perl is in global destruction.  Return
+values and errors are ignored.
 
     sub DEMOLISH {
-        my $self = shift;
+        my ($self, $global_destruct) = @_;
         $self->cleanup();
     }
 

-- 
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/pkg-perl/packages/libclass-tiny-perl.git