From: Dave Rolsky <autarch@urth.org>
Date: Sat, 26 Feb 2011 22:43:21 +0000 (-0600)
Subject: make this module work with Moose 1.99 (and still work with 1.2x)
X-Git-Tag: 0.27~17
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=837c97931c840f5214147d87726e5d5295a99f53;p=gitmo%2FMooseX-Singleton.git

make this module work with Moose 1.99 (and still work with 1.2x)
---

diff --git a/lib/MooseX/Singleton/Role/Meta/Class.pm b/lib/MooseX/Singleton/Role/Meta/Class.pm
index 924a960..975e954 100644
--- a/lib/MooseX/Singleton/Role/Meta/Class.pm
+++ b/lib/MooseX/Singleton/Role/Meta/Class.pm
@@ -39,6 +39,27 @@ override _construct_instance => sub {
     return ${"$pkg\::singleton"} = super;
 };
 
+if ( $Moose::VERSION >= 1.9900 ) {
+    override _inline_params => sub {
+        my $self = shift;
+
+        return
+            'my $existing = do {',
+                'no strict "refs";',
+                'no warnings "once";',
+                '\${"$class\::singleton"};',
+            '};',
+            'return ${$existing} if ${$existing};',
+            super();
+    };
+
+    override _inline_extra_init => sub {
+        my $self = shift;
+
+        return '${$existing} = $instance;';
+    };
+}
+
 no Moose::Role;
 
 1;
diff --git a/lib/MooseX/Singleton/Role/Meta/Method/Constructor.pm b/lib/MooseX/Singleton/Role/Meta/Method/Constructor.pm
index 63c2888..d186ade 100644
--- a/lib/MooseX/Singleton/Role/Meta/Method/Constructor.pm
+++ b/lib/MooseX/Singleton/Role/Meta/Method/Constructor.pm
@@ -4,70 +4,72 @@ use Moose::Role;
 our $VERSION = '0.25';
 $VERSION = eval $VERSION;
 
-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 $defaults = [map { $_->default } @$attrs];
-
-    my ( $code, $e ) = $self->_compile_code(
-        code        => $source,
-        environment => {
-            '$meta'                   => \$self,
-            '$attrs'                  => \$attrs,
-            '$defaults'               => \$defaults,
-            '@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;
-};
+if ( $Moose::VERSION < 1.9900 ) {
+    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 $defaults = [map { $_->default } @$attrs];
+
+        my ( $code, $e ) = $self->_compile_code(
+            code        => $source,
+            environment => {
+                '$meta'                   => \$self,
+                '$attrs'                  => \$attrs,
+                '$defaults'               => \$defaults,
+                '@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.