migrate repository to https://github.com/moose/MooseX-Singleton

[gitmo/MooseX-Singleton.git] / lib / MooseX / Singleton / Role / Meta / Method / Constructor.pm

diff --git a/lib/MooseX/Singleton/Role/Meta/Method/Constructor.pm b/lib/MooseX/Singleton/Role/Meta/Method/Constructor.pm
index 0521977..f8f049e 100644 (file)
--- a/lib/MooseX/Singleton/Role/Meta/Method/Constructor.pm
+++ b/lib/MooseX/Singleton/Role/Meta/Method/Constructor.pm
@@ -1,70 +1,73 @@
 package MooseX::Singleton::Role::Meta::Method::Constructor;
 use Moose::Role;
 
-our $VERSION = '0.24';
-$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 ( $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;
-};
+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.
@@ -93,14 +96,12 @@ no Moose::Role;
 
 1;
 
+# ABSTRACT: Constructor method role for MooseX::Singleton
+
 __END__
 
 =pod
 
-=head1 NAME
-
-MooseX::Singleton::Role::Meta::Method::Constructor - Constructor method role for MooseX::Singleton
-
 =head1 DESCRIPTION
 
 This role overrides the generated object C<new> method so that it returns the