From: Hans Dieter Pearcey <hdp@weftsoar.net>
Date: Fri, 24 Apr 2009 17:55:29 +0000 (-0400)
Subject: _clear_instance and tests
X-Git-Tag: 0.17~1
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=03e1b8df86e9ad4dd27d689d506324942bd20652;p=gitmo%2FMooseX-Singleton.git

_clear_instance and tests
---

diff --git a/ChangeLog b/ChangeLog
index 4993810..61c5a4e 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,8 @@
 Revision history for Perl extension MooseX-Singleton
 
+0.17
+		- Add ClassName->_clear_instance. (hdp)
+
 0.16 2009-04-24
     - Changes to keep constructor inlining working with latest Moose &
       Class::MOP. This module will still work with any Moose from 0.74
diff --git a/lib/MooseX/Singleton.pm b/lib/MooseX/Singleton.pm
index bc2b7ec..fe67b9f 100644
--- a/lib/MooseX/Singleton.pm
+++ b/lib/MooseX/Singleton.pm
@@ -60,11 +60,15 @@ All you should need to do to transform your class is to change C<use Moose> to
 C<use MooseX::Singleton>. This module uses a new class metaclass and instance
 metaclass, so if you're doing metamagic you may not be able to use this.
 
-C<MooseX::Singleton> gives your class an C<instance> method that can be used to get a handle on the singleton. It's actually just an alias for C<new>.
+C<MooseX::Singleton> gives your class an C<instance> method that can be used to
+get a handle on the singleton. It's actually just an alias for C<new>.
 
 Alternatively, C<< YourPackage->method >> should just work. This includes
 accessors.
 
+If you need to reset your class's singleton object for some reason (e.g.
+tests), you can call C<< YourPackage->_clear_instance >>.
+
 =head1 TODO
 
 =over
diff --git a/lib/MooseX/Singleton/Meta/Class.pm b/lib/MooseX/Singleton/Meta/Class.pm
index 529095b..609c250 100644
--- a/lib/MooseX/Singleton/Meta/Class.pm
+++ b/lib/MooseX/Singleton/Meta/Class.pm
@@ -34,6 +34,13 @@ sub existing_singleton {
     return;
 }
 
+sub clear_singleton {
+    my ($class) = @_;
+    my $pkg = $class->name;
+    no strict 'refs';
+    undef ${"$pkg\::singleton"};
+}
+
 override _construct_instance => sub {
     my ($class) = @_;
 
diff --git a/lib/MooseX/Singleton/Object.pm b/lib/MooseX/Singleton/Object.pm
index 07c792a..312e472 100644
--- a/lib/MooseX/Singleton/Object.pm
+++ b/lib/MooseX/Singleton/Object.pm
@@ -28,6 +28,11 @@ sub new {
   return $class->SUPER::new(@args);
 }
 
+sub _clear_instance {
+  my ($class) = @_;
+  $class->meta->clear_singleton;
+}
+
 no Moose;
 
 1;
diff --git a/t/001-basic.t b/t/001-basic.t
index 9cd90b0..b6ad4ff 100644
--- a/t/001-basic.t
+++ b/t/001-basic.t
@@ -1,6 +1,6 @@
 use strict;
 use warnings;
-use Test::More tests => 16;
+use Test::More tests => 17;
 
 BEGIN {
     package MooseX::Singleton::Test;
@@ -67,3 +67,6 @@ is($mst->distinct_keys, 0, "Package->clear works");
 is($mst2->distinct_keys, 0, "Package->clear works");
 is(MooseX::Singleton::Test->distinct_keys, 0, "Package->clear works");
 
+MooseX::Singleton::Test->_clear_instance;
+$mst = $mst2 = undef;
+is(MooseX::Singleton::Test->new->distinct_keys, 1, "back to the default");