From: Hans Dieter Pearcey 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 to C. 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 gives your class an C method that can be used to get a handle on the singleton. It's actually just an alias for C. +C gives your class an C method that can be used to +get a handle on the singleton. It's actually just an alias for C. 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");