tidy all code
Dave Rolsky [Fri, 25 Dec 2009 15:41:08 +0000 (09:41 -0600)]
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
t/001-basic.t
t/003-immutable.t
t/006-cooperative.t

index 6bca2ec..fc8048b 100644 (file)
@@ -10,7 +10,7 @@ sub existing_singleton {
     no strict 'refs';
 
     # create exactly one instance
-    if (defined ${"$pkg\::singleton"}) {
+    if ( defined ${"$pkg\::singleton"} ) {
         return ${"$pkg\::singleton"};
     }
 
index 770de0e..aa88684 100644 (file)
@@ -3,7 +3,7 @@ use Moose::Role;
 use Scalar::Util 'weaken';
 
 sub get_singleton_instance {
-    my ($self, $instance) = @_;
+    my ( $self, $instance ) = @_;
 
     return $instance if blessed $instance;
 
@@ -18,39 +18,42 @@ sub get_singleton_instance {
     return $instance->meta->name->new;
 }
 
-override clone_instance => sub  {
-    my ($self, $instance) = @_;
+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 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) = @_;
+override set_slot_value => sub {
+    my ( $self, $instance, $slot_name, $value ) = @_;
     $self->get_singleton_instance($instance)->{$slot_name} = $value;
 };
 
-override deinitialize_slot => sub  {
+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) = @_;
+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) = @_;
+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;
+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::Role;
index 111fbc3..f1eb90d 100644 (file)
@@ -3,6 +3,7 @@ use Moose::Role;
 
 override _initialize_body => sub {
     my $self = shift;
+
     # TODO:
     # the %options should also include a both
     # a call 'initializer' and call 'SUPER::'
@@ -13,14 +14,18 @@ override _initialize_body => sub {
     my $source = 'sub {';
     $source .= "\n" . 'my $class = shift;';
 
-    $source .= "\n" . 'my $existing = do { no strict "refs"; no warnings "once"; \${"$class\::singleton"}; };';
+    $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
+        .= "\n"
+        . '    if $class ne \''
+        . $self->associated_metaclass->name . '\';';
 
-    $source .= $self->_generate_params('$params', '$class');
-    $source .= $self->_generate_instance('$instance', '$class');
+    $source .= $self->_generate_params( '$params', '$class' );
+    $source .= $self->_generate_instance( '$instance', '$class' );
     $source .= $self->_generate_slot_initializers;
 
     $source .= ";\n" . $self->_generate_triggers();
@@ -32,25 +37,27 @@ override _initialize_body => sub {
 
     my $attrs = $self->_attributes;
 
-    my @type_constraints = map {
-        $_->can('type_constraint') ? $_->type_constraint : undef
-    } @$attrs;
+    my @type_constraints
+        = map { $_->can('type_constraint') ? $_->type_constraint : undef }
+        @$attrs;
 
-    my @type_constraint_bodies = map {
-        defined $_ ? $_->_compiled_type_constraint : undef;
-    } @type_constraints;
+    my @type_constraint_bodies
+        = map { defined $_ ? $_->_compiled_type_constraint : undef; }
+        @type_constraints;
 
     my ( $code, $e ) = $self->_compile_code(
-        code => $source,
+        code        => $source,
         environment => {
-            '$meta'  => \$self,
-            '$attrs' => \$attrs,
-            '@type_constraints' => \@type_constraints,
+            '$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 )
+    $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;
index ae3e278..67129ec 100644 (file)
@@ -4,30 +4,30 @@ use Moose::Role;
 sub instance { shift->new }
 
 sub initialize {
-  my ($class, @args) = @_;
+    my ( $class, @args ) = @_;
 
-  my $existing = $class->meta->existing_singleton;
-  confess "Singleton is already initialized" if $existing;
+    my $existing = $class->meta->existing_singleton;
+    confess "Singleton is already initialized" if $existing;
 
-  return $class->new(@args);
+    return $class->new(@args);
 }
 
 override new => sub {
-  my ($class, @args) = @_;
+    my ( $class, @args ) = @_;
 
-  my $existing = $class->meta->existing_singleton;
-  confess "Singleton is already initialized" if $existing and @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;
+    # Otherwise BUILD will be called repeatedly on the existing instance.
+    # -- rjbs, 2008-02-03
+    return $existing if $existing and !@args;
 
-  return super();
+    return super();
 };
 
 sub _clear_instance {
-  my ($class) = @_;
-  $class->meta->clear_singleton;
+    my ($class) = @_;
+    $class->meta->clear_singleton;
 }
 
 no Moose::Role;
index b6ad4ff..12c0eb2 100644 (file)
@@ -19,12 +19,12 @@ BEGIN {
 
     sub clear {
         my $self = shift;
-        $self->bag({});
+        $self->bag( {} );
     }
 
     sub add {
-        my $self = shift;
-        my $key = shift;
+        my $self  = shift;
+        my $key   = shift;
         my $value = @_ ? shift : 1;
 
         $self->bag->{$key} += $value;
@@ -32,41 +32,43 @@ BEGIN {
 }
 
 my $mst = MooseX::Singleton::Test->instance;
-isa_ok($mst, 'MooseX::Singleton::Test', 'Singleton->instance returns a real instance');
+isa_ok( $mst, 'MooseX::Singleton::Test',
+    'Singleton->instance returns a real instance' );
 
-is($mst->distinct_keys, 1, "default keys");
+is( $mst->distinct_keys, 1, "default keys" );
 
-$mst->add(foo => 10);
-is($mst->distinct_keys, 2, "added key");
+$mst->add( foo => 10 );
+is( $mst->distinct_keys, 2, "added key" );
 
-$mst->add(bar => 5);
-is($mst->distinct_keys, 3, "added another key");
+$mst->add( bar => 5 );
+is( $mst->distinct_keys, 3, "added another key" );
 
 my $mst2 = MooseX::Singleton::Test->instance;
-is($mst, $mst2, 'instances are the same object');
-isa_ok($mst2, 'MooseX::Singleton::Test', 'Singleton->instance returns a real instance');
+is( $mst, $mst2, 'instances are the same object' );
+isa_ok( $mst2, 'MooseX::Singleton::Test',
+    'Singleton->instance returns a real instance' );
 
-is($mst2->distinct_keys, 3, "keys from before");
+is( $mst2->distinct_keys, 3, "keys from before" );
 
-$mst->add(baz => 2);
+$mst->add( baz => 2 );
 
-is($mst->distinct_keys, 4, "attributes are shared even after ->instance");
-is($mst2->distinct_keys, 4, "attributes are shared even after ->instance");
+is( $mst->distinct_keys,  4, "attributes are shared even after ->instance" );
+is( $mst2->distinct_keys, 4, "attributes are shared even after ->instance" );
 
-is(MooseX::Singleton::Test->distinct_keys, 4, "Package->reader works");
+is( MooseX::Singleton::Test->distinct_keys, 4, "Package->reader works" );
 
-MooseX::Singleton::Test->add(quux => 9000);
+MooseX::Singleton::Test->add( quux => 9000 );
 
-is($mst->distinct_keys, 5, "Package->add works");
-is($mst2->distinct_keys, 5, "Package->add works");
-is(MooseX::Singleton::Test->distinct_keys, 5, "Package->add works");
+is( $mst->distinct_keys,                    5, "Package->add works" );
+is( $mst2->distinct_keys,                   5, "Package->add works" );
+is( MooseX::Singleton::Test->distinct_keys, 5, "Package->add works" );
 
 MooseX::Singleton::Test->clear;
 
-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");
+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");
+is( MooseX::Singleton::Test->new->distinct_keys, 1, "back to the default" );
index 1385d07..05ff974 100644 (file)
@@ -5,7 +5,7 @@ use Scalar::Util qw( refaddr );
 use Test::More;
 
 BEGIN {
-    unless ( eval 'use Test::Warn; 1' )  {
+    unless ( eval 'use Test::Warn; 1' ) {
         plan skip_all => 'These tests require Test::Warn';
     }
     else {
@@ -30,12 +30,12 @@ BEGIN {
 
     sub clear {
         my $self = shift;
-        $self->bag({});
+        $self->bag( {} );
     }
 
     sub add {
-        my $self = shift;
-        my $key = shift;
+        my $self  = shift;
+        my $key   = shift;
         my $value = @_ ? shift : 1;
 
         $self->bag->{$key} += $value;
@@ -46,40 +46,42 @@ BEGIN {
 }
 
 my $mst = MooseX::Singleton::Test->instance;
-isa_ok($mst, 'MooseX::Singleton::Test', 'Singleton->instance returns a real instance');
+isa_ok( $mst, 'MooseX::Singleton::Test',
+    'Singleton->instance returns a real instance' );
 
-is($mst->distinct_keys, 1, "default keys");
+is( $mst->distinct_keys, 1, "default keys" );
 
-$mst->add(foo => 10);
-is($mst->distinct_keys, 2, "added key");
+$mst->add( foo => 10 );
+is( $mst->distinct_keys, 2, "added key" );
 
-$mst->add(bar => 5);
-is($mst->distinct_keys, 3, "added another key");
+$mst->add( bar => 5 );
+is( $mst->distinct_keys, 3, "added another key" );
 
 my $mst2 = MooseX::Singleton::Test->instance;
-is($mst, $mst2, 'instances are the same object');
-isa_ok($mst2, 'MooseX::Singleton::Test', 'Singleton->instance returns a real instance');
+is( $mst, $mst2, 'instances are the same object' );
+isa_ok( $mst2, 'MooseX::Singleton::Test',
+    'Singleton->instance returns a real instance' );
 
-is($mst2->distinct_keys, 3, "keys from before");
+is( $mst2->distinct_keys, 3, "keys from before" );
 
-$mst->add(baz => 2);
+$mst->add( baz => 2 );
 
-is($mst->distinct_keys, 4, "attributes are shared even after ->instance");
-is($mst2->distinct_keys, 4, "attributes are shared even after ->instance");
+is( $mst->distinct_keys,  4, "attributes are shared even after ->instance" );
+is( $mst2->distinct_keys, 4, "attributes are shared even after ->instance" );
 
-is(MooseX::Singleton::Test->distinct_keys, 4, "Package->reader works");
+is( MooseX::Singleton::Test->distinct_keys, 4, "Package->reader works" );
 
-MooseX::Singleton::Test->add(quux => 9000);
+MooseX::Singleton::Test->add( quux => 9000 );
 
-is($mst->distinct_keys, 5, "Package->add works");
-is($mst2->distinct_keys, 5, "Package->add works");
-is(MooseX::Singleton::Test->distinct_keys, 5, "Package->add works");
+is( $mst->distinct_keys,                    5, "Package->add works" );
+is( $mst2->distinct_keys,                   5, "Package->add works" );
+is( MooseX::Singleton::Test->distinct_keys, 5, "Package->add works" );
 
 MooseX::Singleton::Test->clear;
 
-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");
+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" );
 
 {
     my $addr;
@@ -88,7 +90,8 @@ is(MooseX::Singleton::Test->distinct_keys, 0, "Package->clear works");
         $addr = refaddr( MooseX::Singleton::Test->instance );
     }
 
-    is( $addr, refaddr( MooseX::Singleton::Test->instance ),
-        'singleton is not randomly destroyed' );
+    is(
+        $addr, refaddr( MooseX::Singleton::Test->instance ),
+        'singleton is not randomly destroyed'
+    );
 }
-
index 7924cc3..ed5d2c0 100644 (file)
@@ -5,7 +5,8 @@ use Test::More;
 
 BEGIN {
     eval "require MooseX::StrictConstructor; use Test::Exception; 1;";
-    plan skip_all => 'This test requires MooseX::StrictConstructor and Test::Exception'
+    plan skip_all =>
+        'This test requires MooseX::StrictConstructor and Test::Exception'
         if $@;
 }
 
@@ -17,12 +18,10 @@ plan 'no_plan';
     use MooseX::Singleton;
     use MooseX::StrictConstructor;
 
-    has 'attrib' =>
-        is      => 'rw';
+    has 'attrib' => is => 'rw';
 }
 
 throws_ok {
-    MySingleton->new( bad_name => 42 )
+    MySingleton->new( bad_name => 42 );
 }
-qr/Found unknown attribute/,
-'singleton class also has a strict constructor';
+qr/Found unknown attribute/, 'singleton class also has a strict constructor';