r44319 - in /branches/upstream/libmoosex-singleton-perl/current: ./ lib/MooseX/ lib/MooseX/Singleton/ lib/MooseX/Singleton/Meta/ lib/MooseX/Singleton/Role/ lib/MooseX/Singleton/Role/Meta/ lib/MooseX/Singleton/Role/Meta/Method/ t/
jawnsy-guest at users.alioth.debian.org
jawnsy-guest at users.alioth.debian.org
Sat Sep 19 16:54:10 UTC 2009
Author: jawnsy-guest
Date: Sat Sep 19 16:54:05 2009
New Revision: 44319
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=44319
Log:
[svn-upgrade] Integrating new upstream version, libmoosex-singleton-perl (0.21)
Added:
branches/upstream/libmoosex-singleton-perl/current/lib/MooseX/Singleton/Role/
branches/upstream/libmoosex-singleton-perl/current/lib/MooseX/Singleton/Role/Meta/
branches/upstream/libmoosex-singleton-perl/current/lib/MooseX/Singleton/Role/Meta/Class.pm
branches/upstream/libmoosex-singleton-perl/current/lib/MooseX/Singleton/Role/Meta/Instance.pm
branches/upstream/libmoosex-singleton-perl/current/lib/MooseX/Singleton/Role/Meta/Method/
branches/upstream/libmoosex-singleton-perl/current/lib/MooseX/Singleton/Role/Meta/Method/Constructor.pm
branches/upstream/libmoosex-singleton-perl/current/lib/MooseX/Singleton/Role/Object.pm
branches/upstream/libmoosex-singleton-perl/current/t/006-cooperative.t
Removed:
branches/upstream/libmoosex-singleton-perl/current/lib/MooseX/Singleton/Meta/
branches/upstream/libmoosex-singleton-perl/current/lib/MooseX/Singleton/Object.pm
Modified:
branches/upstream/libmoosex-singleton-perl/current/ChangeLog
branches/upstream/libmoosex-singleton-perl/current/MANIFEST
branches/upstream/libmoosex-singleton-perl/current/META.yml
branches/upstream/libmoosex-singleton-perl/current/lib/MooseX/Singleton.pm
Modified: branches/upstream/libmoosex-singleton-perl/current/ChangeLog
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmoosex-singleton-perl/current/ChangeLog?rev=44319&op=diff
==============================================================================
--- branches/upstream/libmoosex-singleton-perl/current/ChangeLog (original)
+++ branches/upstream/libmoosex-singleton-perl/current/ChangeLog Sat Sep 19 16:54:05 2009
@@ -1,4 +1,14 @@
Revision history for Perl extension MooseX-Singleton
+
+0.21 2009-09-12
+ - Various modules in this class were trying to load the old pre-0.20
+ classes, which have all been renamed. Tests passed if you had 0.19 or
+ earlier installed, but failed for fresh installations. (Dave Rolsky)
+
+0.20 2009-09-11
+ - Converted this extension to use roles rather than metaclass
+ subclasses. This means it will cooperate with other extensions on CPAN,
+ like MooseX::StrictConstructor, etc. (Dave Rolsky)
0.19 2009-07-09
- Remove ambiguity about copyright holder (Sartak)
Modified: branches/upstream/libmoosex-singleton-perl/current/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmoosex-singleton-perl/current/MANIFEST?rev=44319&op=diff
==============================================================================
--- branches/upstream/libmoosex-singleton-perl/current/MANIFEST (original)
+++ branches/upstream/libmoosex-singleton-perl/current/MANIFEST Sat Sep 19 16:54:05 2009
@@ -8,16 +8,16 @@
inc/Module/Install/Win32.pm
inc/Module/Install/WriteAll.pm
lib/MooseX/Singleton.pm
-lib/MooseX/Singleton/Meta/Class.pm
-lib/MooseX/Singleton/Meta/Instance.pm
-lib/MooseX/Singleton/Meta/Method/Constructor.pm
-lib/MooseX/Singleton/Object.pm
+lib/MooseX/Singleton/Role/Meta/Class.pm
+lib/MooseX/Singleton/Role/Meta/Instance.pm
+lib/MooseX/Singleton/Role/Meta/Method/Constructor.pm
+lib/MooseX/Singleton/Role/Object.pm
Makefile.PL
MANIFEST This list of files
META.yml
-README
t/001-basic.t
t/002-init.t
t/003-immutable.t
t/004-build_bug.t
t/005-build_bug-immutable.t
+t/006-cooperative.t
Modified: branches/upstream/libmoosex-singleton-perl/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmoosex-singleton-perl/current/META.yml?rev=44319&op=diff
==============================================================================
--- branches/upstream/libmoosex-singleton-perl/current/META.yml (original)
+++ branches/upstream/libmoosex-singleton-perl/current/META.yml Sat Sep 19 16:54:05 2009
@@ -23,4 +23,4 @@
Moose: 0.82
resources:
license: http://dev.perl.org/licenses/
-version: 0.19
+version: 0.21
Modified: branches/upstream/libmoosex-singleton-perl/current/lib/MooseX/Singleton.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmoosex-singleton-perl/current/lib/MooseX/Singleton.pm?rev=44319&op=diff
==============================================================================
--- branches/upstream/libmoosex-singleton-perl/current/lib/MooseX/Singleton.pm (original)
+++ branches/upstream/libmoosex-singleton-perl/current/lib/MooseX/Singleton.pm Sat Sep 19 16:54:05 2009
@@ -2,22 +2,41 @@
use Moose 0.82 ();
use Moose::Exporter;
-use MooseX::Singleton::Object;
-use MooseX::Singleton::Meta::Class;
+use MooseX::Singleton::Role::Object;
+use MooseX::Singleton::Role::Meta::Class;
+use MooseX::Singleton::Role::Meta::Instance;
-our $VERSION = '0.19';
+our $VERSION = '0.21';
$VERSION = eval $VERSION;
Moose::Exporter->setup_import_methods( also => 'Moose' );
sub init_meta {
shift;
- Moose->init_meta(
- @_,
- base_class => 'MooseX::Singleton::Object',
- metaclass => 'MooseX::Singleton::Meta::Class',
+ my %p = @_;
+
+ Moose->init_meta(%p);
+
+ my $caller = $p{for_class};
+
+ Moose::Util::MetaRole::apply_metaclass_roles(
+ for_class => $caller,
+ metaclass_roles => ['MooseX::Singleton::Role::Meta::Class'],
+ instance_metaclass_roles =>
+ ['MooseX::Singleton::Role::Meta::Instance'],
+ constructor_class_roles =>
+ ['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;
@@ -28,10 +47,6 @@
=head1 NAME
MooseX::Singleton - turn your Moose class into a singleton
-
-=head1 VERSION
-
-Version 0.18, released 24 May 08
=head1 SYNOPSIS
Added: branches/upstream/libmoosex-singleton-perl/current/lib/MooseX/Singleton/Role/Meta/Class.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmoosex-singleton-perl/current/lib/MooseX/Singleton/Role/Meta/Class.pm?rev=44319&op=file
==============================================================================
--- branches/upstream/libmoosex-singleton-perl/current/lib/MooseX/Singleton/Role/Meta/Class.pm (added)
+++ branches/upstream/libmoosex-singleton-perl/current/lib/MooseX/Singleton/Role/Meta/Class.pm Sat Sep 19 16:54:05 2009
@@ -1,0 +1,59 @@
+#!/usr/bin/env perl
+package MooseX::Singleton::Role::Meta::Class;
+use Moose::Role;
+use MooseX::Singleton::Role::Meta::Instance;
+use MooseX::Singleton::Role::Meta::Method::Constructor;
+
+sub existing_singleton {
+ my ($class) = @_;
+ my $pkg = $class->name;
+
+ no strict 'refs';
+
+ # create exactly one instance
+ if (defined ${"$pkg\::singleton"}) {
+ return ${"$pkg\::singleton"};
+ }
+
+ return;
+}
+
+sub clear_singleton {
+ my ($class) = @_;
+ my $pkg = $class->name;
+ no strict 'refs';
+ undef ${"$pkg\::singleton"};
+}
+
+override _construct_instance => sub {
+ my ($class) = @_;
+
+ # create exactly one instance
+ my $existing = $class->existing_singleton;
+ return $existing if $existing;
+
+ my $pkg = $class->name;
+ no strict 'refs';
+ return ${"$pkg\::singleton"} = super;
+};
+
+no Moose;
+
+1;
+
+__END__
+
+=pod
+
+=head1 NAME
+
+MooseX::Singleton::Role::Meta::Class - Metaclass role for MooseX::Singleton
+
+=head1 DESCRIPTION
+
+This metaclass role makes sure that there is only ever one instance of an
+object for a singleton class. The first call to C<construct_instance> is run
+normally (and then cached). Subsequent calls will return the cached version.
+
+=cut
+
Added: branches/upstream/libmoosex-singleton-perl/current/lib/MooseX/Singleton/Role/Meta/Instance.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmoosex-singleton-perl/current/lib/MooseX/Singleton/Role/Meta/Instance.pm?rev=44319&op=file
==============================================================================
--- branches/upstream/libmoosex-singleton-perl/current/lib/MooseX/Singleton/Role/Meta/Instance.pm (added)
+++ branches/upstream/libmoosex-singleton-perl/current/lib/MooseX/Singleton/Role/Meta/Instance.pm Sat Sep 19 16:54:05 2009
@@ -1,0 +1,75 @@
+#!/usr/bin/env perl
+package MooseX::Singleton::Role::Meta::Instance;
+use Moose::Role;
+use Scalar::Util 'weaken';
+
+sub get_singleton_instance {
+ my ($self, $instance) = @_;
+
+ return $instance if blessed $instance;
+
+ # optimization: it's really slow to go through new_object for every access
+ # so return the singleton if we see it already exists, which it will every
+ # single except the first.
+ no strict 'refs';
+ return ${"$instance\::singleton"} if defined ${"$instance\::singleton"};
+
+ # We need to go through ->new in order to make sure BUILD and
+ # BUILDARGS get called.
+ return $instance->meta->name->new;
+}
+
+override clone_instance => sub {
+ my ($self, $instance) = @_;
+ $self->get_singleton_instance($instance);
+};
+
+override get_slot_value => sub {
+ my ($self, $instance, $slot_name) = @_;
+ $self->is_slot_initialized($instance, $slot_name) ? $self->get_singleton_instance($instance)->{$slot_name} : undef;
+};
+
+override set_slot_value => sub {
+ my ($self, $instance, $slot_name, $value) = @_;
+ $self->get_singleton_instance($instance)->{$slot_name} = $value;
+};
+
+override deinitialize_slot => sub {
+ my ( $self, $instance, $slot_name ) = @_;
+ delete $self->get_singleton_instance($instance)->{$slot_name};
+};
+
+override is_slot_initialized => sub {
+ my ($self, $instance, $slot_name, $value) = @_;
+ exists $self->get_singleton_instance($instance)->{$slot_name} ? 1 : 0;
+};
+
+override weaken_slot_value => sub {
+ my ($self, $instance, $slot_name) = @_;
+ weaken $self->get_singleton_instance($instance)->{$slot_name};
+};
+
+override inline_slot_access => sub {
+ my ($self, $instance, $slot_name) = @_;
+ sprintf "%s->meta->instance_metaclass->get_singleton_instance(%s)->{%s}", $instance, $instance, $slot_name;
+};
+
+no Moose;
+
+1;
+
+__END__
+
+=pod
+
+=head1 NAME
+
+MooseX::Singleton::Role::Meta::Instance - Instance metaclass role for MooseX::Singleton
+
+=head1 DESCRIPTION
+
+This role overrides all object access so that it gets the appropriate
+singleton instance for the class.
+
+=cut
+
Added: branches/upstream/libmoosex-singleton-perl/current/lib/MooseX/Singleton/Role/Meta/Method/Constructor.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmoosex-singleton-perl/current/lib/MooseX/Singleton/Role/Meta/Method/Constructor.pm?rev=44319&op=file
==============================================================================
--- branches/upstream/libmoosex-singleton-perl/current/lib/MooseX/Singleton/Role/Meta/Method/Constructor.pm (added)
+++ branches/upstream/libmoosex-singleton-perl/current/lib/MooseX/Singleton/Role/Meta/Method/Constructor.pm Sat Sep 19 16:54:05 2009
@@ -1,0 +1,85 @@
+#!/usr/bin/env perl
+package MooseX::Singleton::Role::Meta::Method::Constructor;
+use Moose::Role;
+
+override _initialize_body => sub {
+ my $self = shift;
+ # TODO:
+ # the %options should also include a both
+ # a call 'initializer' and call 'SUPER::'
+ # options, which should cover approx 90%
+ # of the possible use cases (even if it
+ # requires some adaption on the part of
+ # the author, after all, nothing is free)
+ my $source = 'sub {';
+ $source .= "\n" . 'my $class = shift;';
+
+ $source .= "\n" . 'my $existing = do { no strict "refs"; no warnings "once"; \${"$class\::singleton"}; };';
+ $source .= "\n" . 'return ${$existing} if ${$existing};';
+
+ $source .= "\n" . 'return $class->Moose::Object::new(@_)';
+ $source .= "\n" . ' if $class ne \'' . $self->associated_metaclass->name . '\';';
+
+ $source .= $self->_generate_params('$params', '$class');
+ $source .= $self->_generate_instance('$instance', '$class');
+ $source .= $self->_generate_slot_initializers;
+
+ $source .= ";\n" . $self->_generate_triggers();
+ $source .= ";\n" . $self->_generate_BUILDALL();
+
+ $source .= ";\n" . 'return ${$existing} = $instance';
+ $source .= ";\n" . '}';
+ warn $source if $self->options->{debug};
+
+ my $attrs = $self->_attributes;
+
+ my @type_constraints = map {
+ $_->can('type_constraint') ? $_->type_constraint : undef
+ } @$attrs;
+
+ my @type_constraint_bodies = map {
+ defined $_ ? $_->_compiled_type_constraint : undef;
+ } @type_constraints;
+
+ my ( $code, $e ) = $self->_compile_code(
+ code => $source,
+ environment => {
+ '$meta' => \$self,
+ '$attrs' => \$attrs,
+ '@type_constraints' => \@type_constraints,
+ '@type_constraint_bodies' => \@type_constraint_bodies,
+ },
+ );
+
+ $self->throw_error("Could not eval the constructor :\n\n$source\n\nbecause :\n\n$e", error => $e, data => $source )
+ if $e;
+
+ $self->{'body'} = $code;
+};
+
+# Ideally we'd be setting this in the constructor, but the new() methods in
+# what the parent classes are not well-factored.
+#
+# This is all a nasty hack, though. We need to fix Class::MOP::Inlined to
+# allow constructor class roles to say "if the parent class has role X,
+# inline".
+override _expected_method_class => sub {
+ my $self = shift;
+
+ my $super_value = super();
+ if ( $super_value eq 'Moose::Object' ) {
+ for my $parent ( map { Class::MOP::class_of($_) }
+ $self->associated_metaclass->superclasses ) {
+ return $parent->name
+ if $parent->is_anon_class
+ && grep { $_->name eq 'Moose::Object' }
+ map { Class::MOP::class_of($_) } $parent->superclasses;
+ }
+ }
+
+ return $super_value;
+};
+
+no Moose;
+
+1;
Added: branches/upstream/libmoosex-singleton-perl/current/lib/MooseX/Singleton/Role/Object.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmoosex-singleton-perl/current/lib/MooseX/Singleton/Role/Object.pm?rev=44319&op=file
==============================================================================
--- branches/upstream/libmoosex-singleton-perl/current/lib/MooseX/Singleton/Role/Object.pm (added)
+++ branches/upstream/libmoosex-singleton-perl/current/lib/MooseX/Singleton/Role/Object.pm Sat Sep 19 16:54:05 2009
@@ -1,0 +1,51 @@
+#!/usr/bin/env perl
+package MooseX::Singleton::Role::Object;
+use Moose::Role;
+
+sub instance { shift->new }
+
+sub initialize {
+ my ($class, @args) = @_;
+
+ my $existing = $class->meta->existing_singleton;
+ confess "Singleton is already initialized" if $existing;
+
+ return $class->SUPER::new(@args);
+}
+
+override new => sub {
+ my ($class, @args) = @_;
+
+ my $existing = $class->meta->existing_singleton;
+ confess "Singleton is already initialized" if $existing and @args;
+
+ # Otherwise BUILD will be called repeatedly on the existing instance.
+ # -- rjbs, 2008-02-03
+ return $existing if $existing and ! @args;
+
+ return super();
+};
+
+sub _clear_instance {
+ my ($class) = @_;
+ $class->meta->clear_singleton;
+}
+
+no Moose;
+
+1;
+
+__END__
+
+=pod
+
+=head1 NAME
+
+MooseX::Singleton::Object - Object class role for MooseX::Singleton
+
+=head1 DESCRIPTION
+
+This just adds C<instance> as a shortcut for C<new>.
+
+=cut
+
Added: branches/upstream/libmoosex-singleton-perl/current/t/006-cooperative.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmoosex-singleton-perl/current/t/006-cooperative.t?rev=44319&op=file
==============================================================================
--- branches/upstream/libmoosex-singleton-perl/current/t/006-cooperative.t (added)
+++ branches/upstream/libmoosex-singleton-perl/current/t/006-cooperative.t Sat Sep 19 16:54:05 2009
@@ -1,0 +1,28 @@
+use strict;
+use warnings;
+
+use Test::More;
+
+BEGIN {
+ eval "require MooseX::StrictConstructor; use Test::Exception; 1;";
+ plan skip_all => 'This test requires MooseX::StrictConstructor and Test::Exception'
+ if $@;
+}
+
+plan 'no_plan';
+
+{
+ package MySingleton;
+ use Moose;
+ use MooseX::Singleton;
+ use MooseX::StrictConstructor;
+
+ has 'attrib' =>
+ is => 'rw';
+}
+
+throws_ok {
+ MySingleton->new( bad_name => 42 )
+}
+qr/Found unknown attribute/,
+'singleton class also has a strict constructor';
More information about the Pkg-perl-cvs-commits
mailing list