rework ChainedAccessors to live in a single file in MooseX::Attribute…

…::Chained
monken · Jan 14, 2012 · 5c9cb19 · 5c9cb19
1 parent eeb9d98
commit 5c9cb19
Show file tree

Hide file tree

Showing 7 changed files with 167 additions and 51 deletions.
diff --git a/lib/Moose/Meta/Attribute/Custom/Trait/Chained.pm b/lib/Moose/Meta/Attribute/Custom/Trait/Chained.pm
@@ -1,7 +1,12 @@
 package Moose::Meta::Attribute::Custom::Trait::Chained;
+
+# ABSTRACT: DEPRECATED
 use strict;
 use warnings;
+no warnings 'redefine';
+use MooseX::Attribute::Chained;
+warn
+    "Implicit use of the Chained trait is deprecated. Please load MooseX::Attribute::Chained explicitly";
+sub register_implementation {'MooseX::Traits::Attribute::Chained'}
 
-sub register_implementation { 'MooseX::Traits::Attribute::Chained' }
-
-1;
+1;
diff --git a/lib/MooseX/Attribute/Chained.pm b/lib/MooseX/Attribute/Chained.pm
@@ -0,0 +1,116 @@
+package MooseX::Attribute::Chained;
+
+# ABSTRACT: Attribute that returns the instance to allow for chaining
+use Moose::Util;
+Moose::Util::meta_attribute_alias(
+    Chained => 'MooseX::Traits::Attribute::Chained' );
+
+package MooseX::Traits::Attribute::Chained;
+use Moose::Role;
+
+override accessor_metaclass => sub {
+    'MooseX::Attribute::Chained::Method::Accessor';
+};
+
+package MooseX::Attribute::Chained::Method::Accessor;
+use Carp qw(confess);
+use Try::Tiny;
+use base 'Moose::Meta::Method::Accessor';
+
+sub _generate_accessor_method_inline {
+    my $self = shift;
+    my $attr = $self->associated_attribute;
+    my $clone
+        = $attr->associated_class->has_method("clone")
+        ? '$_[0]->clone'
+        : 'bless { %{$_[0]} }, ref $_[0]';
+
+    if ( $Moose::VERSION >= 1.9900 ) {
+        return try {
+            $self->_compile_code(
+                [   'sub {',
+                    'if (@_ > 1) {',
+                    $attr->_inline_set_value( '$_[0]', '$_[1]' ),
+                    'return $_[0];',
+                    '}',
+                    $attr->_inline_get_value('$_[0]'),
+                    '}',
+                ]
+            );
+        }
+        catch {
+            confess "Could not generate inline accessor because : $_";
+        };
+    }
+    else {
+        return $self->next::method(@_);
+    }
+}
+
+sub _generate_writer_method_inline {
+    my $self = shift;
+    my $attr = $self->associated_attribute;
+    my $clone
+        = $attr->associated_class->has_method("clone")
+        ? '$_[0]->clone'
+        : 'bless { %{$_[0]} }, ref $_[0]';
+    if ( $Moose::VERSION >= 1.9900 ) {
+        return try {
+            $self->_compile_code(
+                [   'sub {', $attr->_inline_set_value( '$_[0]', '$_[1]' ),
+                    '$_[0]', '}',
+                ]
+            );
+        }
+        catch {
+            confess "Could not generate inline writer because : $_";
+        };
+    }
+    else {
+        return $self->next::method(@_);
+    }
+}
+
+sub _inline_post_body {
+    return 'return $_[0] if (scalar(@_) >= 2);' . "\n";
+}
+
+1;
+
+=head1 SYNOPSIS
+
+  package Test;
+  use Moose;
+
+  has debug => (
+      traits => [ 'Chained' ],
+      is => 'rw',
+      isa => 'Bool',
+  );
+
+  sub complex_method
+  {
+      my $self = shift;
+    
+      #...
+    
+      print "helper message" if $self->debug;
+    
+      #...
+  }
+
+
+  1;
+
+Which allows for:
+
+    my $test = Test->new;
+    $test->debug(1)->complex_method;
+
+    $test->debug(1); # returns $test
+    $test->debug;    # returns 1
+    
+=head1 DESCRIPTION
+
+MooseX::Attribute::Chained is a Moose Trait which allows for method chaining 
+on accessors by returning $self on write/set operations.
diff --git a/lib/MooseX/ChainedAccessors.pm b/lib/MooseX/ChainedAccessors.pm
@@ -1,5 +1,5 @@
 package MooseX::ChainedAccessors;
-# ABSTRACT: Accessor class for chained accessors with Moose
+# ABSTRACT: DEPRECATED
 use strict;
 use warnings;
 use Carp qw(confess);
@@ -47,38 +47,7 @@ sub _generate_writer_method_inline {
 
 __END__
 
-=head1 SYNOPSIS
-
-    package Test;
-    use Moose;
-    
-    has => 'debug' => (
-        traits => [ 'Chained' ],
-        is => 'rw',
-        isa => 'Bool',
-    );
-    
-    sub complex_method
-    {
-        my $self = shift;
-        
-        #...
-        
-        print "helper message" if $self->debug;
-        
-        #...
-    }
-    
-    
-    1;
-
-Which allows for:
-
-    my $test = Test->new();
-    $test->debug(1)->complex_method();
-    
 =head1 DESCRIPTION
 
-MooseX::ChainedAccessors is a Moose Trait which allows for method chaining 
-on accessors by returning $self on write/set operations. 
+Deprecated in favor of L<MooseX::Attribute::Chained>.
 
diff --git a/lib/MooseX/ChainedAccessors/Accessor.pm b/lib/MooseX/ChainedAccessors/Accessor.pm
@@ -1,4 +1,5 @@
 package MooseX::ChainedAccessors::Accessor;
+# ABSTRACT: DEPRECATED
 use strict;
 use warnings;
 use base 'Moose::Meta::Method::Accessor';

diff --git a/lib/MooseX/Traits/Attribute/Chained.pm b/lib/MooseX/Traits/Attribute/Chained.pm
@@ -1,5 +1,5 @@
 package MooseX::Traits::Attribute::Chained;
-#ABSTRACT: Create method chaining attributes
+# ABSTRACT: DEPRECATED
 use Moose::Role;
 use MooseX::ChainedAccessors::Accessor;
 use MooseX::ChainedAccessors;
@@ -12,16 +12,7 @@ no Moose::Role;
 
 __END__
 
-=head1 SYNOPSIS
 
-    has => 'debug' => (
-        traits => [ 'Chained' ],
-        is => 'rw',
-        isa => 'Bool',
-    );
-    
 =head1 DESCRIPTION
 
-Modifies the Accessor Metaclass to use MooseX::ChainedAccessors::Accessor
-
-
+Deprecated in favor of L<MooseX::Attribute::Chained>.
diff --git a/t/chained.t b/t/chained.t
@@ -1,10 +1,8 @@
-#!/usr/bin/perl
 use strict;
 use warnings;
+use Test::More;
 
-use Test::More; 
-
-use_ok('Moose::Meta::Attribute::Custom::Trait::Chained');
+use_ok('MooseX::Attribute::Chained');
 use_ok('MooseX::ChainedAccessors::Accessor');
 use_ok('MooseX::Traits::Attribute::Chained');
 

diff --git a/t/chained_deprecated.t b/t/chained_deprecated.t
@@ -0,0 +1,36 @@
+use strict;
+use warnings;
+use Test::More;
+
+package SimpleChained;
+use Moose;
+
+has 'regular_attr' => (
+    is      => 'rw',
+    isa     => 'Str',
+    default => sub { 'hello'; },
+);
+
+has 'chained_attr' => (
+    traits  => ['Chained'],
+    is      => 'rw',
+    isa     => 'Bool',
+    lazy    => 1,
+    default => sub { 0; },
+);
+
+has 'writer_attr' => (
+    traits => ['Chained'],
+    is     => 'rw',
+    isa    => 'Str',
+    reader => 'get_writer_attr',
+    writer => 'set_writer_attr',
+);
+
+package main;
+
+my $simple = SimpleChained->new();
+is($simple->chained_attr(1)->regular_attr, 'hello', 'chained accessor attribute');
+is($simple->chained_attr(0)->set_writer_attr('world')->get_writer_attr, 'world', 'chained writer attribute');
+
+done_testing;