X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=gitmo%2FMooseX-Singleton.git;a=blobdiff_plain;f=lib%2FMooseX%2FSingleton.pm;h=b73707eeef42b51c8f4d0dbb24f5dcdada335b98;hp=c0bb14d966bceb0cff12f28214366aa992b920f8;hb=51e6046bc95a815f79db1c079b4c0ee43243ad2a;hpb=1467693305140ae67c90d332344ef89d02d91fa4 diff --git a/lib/MooseX/Singleton.pm b/lib/MooseX/Singleton.pm index c0bb14d..b73707e 100644 --- a/lib/MooseX/Singleton.pm +++ b/lib/MooseX/Singleton.pm @@ -1,25 +1,137 @@ package MooseX::Singleton; -use Moose::Role; -our $VERSION = 0.02; +use Moose 0.94 (); +use Moose::Exporter; +use MooseX::Singleton::Role::Object; +use MooseX::Singleton::Role::Meta::Class; +use MooseX::Singleton::Role::Meta::Instance; -override new => sub { - my ($class) = @_; +our $VERSION = '0.23'; +$VERSION = eval $VERSION; - no strict 'refs'; +Moose::Exporter->setup_import_methods( also => 'Moose' ); - # create our instance if we don't already have one - if (!defined ${"$class\::singleton"}) { - ${"$class\::singleton"} = super; - } +sub init_meta { + shift; + my %p = @_; - return ${"$class\::singleton"}; -}; + Moose->init_meta(%p); -# instance really is the same as new. any ideas for a better implementation? -sub instance { - shift->new(@_); + my $caller = $p{for_class}; + + Moose::Util::MetaRole::apply_metaroles( + for => $caller, + class_metaroles => { + class => ['MooseX::Singleton::Role::Meta::Class'], + instance => + ['MooseX::Singleton::Role::Meta::Instance'], + constructor => + ['MooseX::Singleton::Role::Meta::Method::Constructor'], + }, + ); + + Moose::Util::MetaRole::apply_base_class_roles( + for_class => $caller, + roles => + ['MooseX::Singleton::Role::Object'], + ); + + return $caller->meta(); } + 1; +__END__ + +=pod + +=head1 NAME + +MooseX::Singleton - turn your Moose class into a singleton + +=head1 SYNOPSIS + + package MyApp; + use MooseX::Singleton; + + has env => ( + is => 'rw', + isa => 'HashRef[Str]', + default => sub { \%ENV }, + ); + + package main; + + delete MyApp->env->{PATH}; + my $instance = MyApp->instance; + my $same = MyApp->instance; + +=head1 DESCRIPTION + +A singleton is a class that has only one instance in an application. +C lets you easily upgrade (or downgrade, as it were) your +L class to a singleton. + +All you should need to do to transform your class is to change C to +C. This module uses metaclass roles to do its magic, so +it should cooperate with most other C modules. + +=head1 METHODS + +A singleton class will have the following additional methods: + +=head2 Singleton->instance + +This returns the singleton instance for the given package. This method does +I accept any arguments. If the instance does not yet exist, it is created +with its defaults values. This means that if your singleton requires +arguments, calling C will die if the object has not already been +initialized. + +=head2 Singleton->initialize(%args) + +This method can be called I. It explicitly initializes +the singleton object with the given arguments. + +=head2 Singleton->_clear_instance + +This clears the existing singleton instance for the class. Obviously, this is +meant for use only inside the class itself. + +=head2 Singleton->new + +This method currently works like a hybrid of C and +C. However, calling C directly will probably be deprecated in a +future release. Instead, call C or C as appropriate. + +=head1 BUGS + +Please report any bugs or feature requests to +C, or through the web interface at +L. We will be notified, and then you'll automatically be +notified of progress on your bug as we make changes. + +=head1 AUTHORS + +Shawn M Moore Esartak@gmail.comE + +Dave Rolsky Eautarch@urth.orgE + +=head1 SOME CODE STOLEN FROM + +Anders Nor Berle Edebolaz@gmail.comE + +=head1 AND PATCHES FROM + +Ricardo SIGNES Erjbs@cpan.orgE + +=head1 COPYRIGHT AND LICENSE + +Copyright 2007-2009 Infinity Interactive + +This program is free software; you can redistribute it and/or modify it under +the same terms as Perl itself. + +=cut +