auto_deref

diff --git a/TODO b/TODO
index b709e2d..98fd5f6 100644 (file)
--- a/TODO
+++ b/TODO
@@ -60,8 +60,6 @@ and that if this usage style is used nothing is exported to the namespace.
 
 - default should dclone()
 
-- auto_deref => 1 for auto-de-refing ARRAY and HASH attrs
-
 - subtype $anon_subtype => where { ... }
 
 [22:56]        stevan  sub mst_doesnt_like_to_type { (shift)->meta->attr->type_contstraint }

diff --git a/lib/Moose/Meta/Attribute.pm b/lib/Moose/Meta/Attribute.pm
index d5e3b8f..e441481 100644 (file)
--- a/lib/Moose/Meta/Attribute.pm
+++ b/lib/Moose/Meta/Attribute.pm
@@ -13,10 +13,11 @@ use Moose::Util::TypeConstraints ();
 
 use base 'Class::MOP::Attribute';
 
-__PACKAGE__->meta->add_attribute('required' => (reader => 'is_required'  ));
-__PACKAGE__->meta->add_attribute('lazy'     => (reader => 'is_lazy'      ));
-__PACKAGE__->meta->add_attribute('coerce'   => (reader => 'should_coerce'));
-__PACKAGE__->meta->add_attribute('weak_ref' => (reader => 'is_weak_ref'  ));
+__PACKAGE__->meta->add_attribute('required'   => (reader => 'is_required'      ));
+__PACKAGE__->meta->add_attribute('lazy'       => (reader => 'is_lazy'          ));
+__PACKAGE__->meta->add_attribute('coerce'     => (reader => 'should_coerce'    ));
+__PACKAGE__->meta->add_attribute('weak_ref'   => (reader => 'is_weak_ref'      ));
+__PACKAGE__->meta->add_attribute('auto_deref' => (reader => 'should_auto_deref'));
 __PACKAGE__->meta->add_attribute('type_constraint' => (
     reader    => 'type_constraint',
     predicate => 'has_type_constraint',
@@ -239,6 +240,25 @@ sub _inline_get {
     return $mi->inline_get_slot_value($instance, $slot_name);
 }
 
+sub _inline_auto_deref {
+    my ( $self, $ref_value ) = @_;
+
+    return $ref_value unless $self->should_auto_deref;
+
+    my $type = eval { $self->type_constraint->name } || '';
+    my $sigil;
+
+    if ( $type eq "ArrayRef" ) {
+        $sigil = '@';
+    } elsif ( $type eq 'HashRef' ) {
+        $sigil = '%';
+    } else {
+        confess "Can't auto deref unless type constraint is ArrayRef or HashRef";
+    }
+
+    "(wantarray() ? $sigil\{ ( $ref_value ) || return } : ( $ref_value ) )";
+}
+
 sub generate_accessor_method {
     my ($attr, $attr_name) = @_;
     my $value_name = $attr->should_coerce ? '$val' : '$_[1]';
@@ -261,7 +281,7 @@ sub generate_accessor_method {
             '$_[0]->{$attr_name} = ($attr->has_default ? $attr->default($_[0]) : undef)'
             . 'unless exists $_[0]->{$attr_name};'
             : '')    
-    . 'return ' . $attr->_inline_get( $inv )
+    . 'return ' . $attr->_inline_auto_deref( $attr->_inline_get( $inv ) )
     . ' }';
     my $sub = eval $code;
     warn "Could not create accessor for '$attr_name' because $@ \n code: $code" if $@;
@@ -298,7 +318,7 @@ sub generate_reader_method {
             '$_[0]->{$attr_name} = ($self->has_default ? $self->default($_[0]) : undef)'
             . 'unless exists $_[0]->{$attr_name};'
             : '')
-    . 'return $_[0]->{$attr_name};'
+    . 'return ' . $self->_inline_auto_deref( '$_[0]->{$attr_name}' ) . ';'
     . '}';
     my $sub = eval $code;
     confess "Could not create reader for '$attr_name' because $@ \n code: $code" if $@;

diff --git a/lib/Moose/Meta/Class.pm b/lib/Moose/Meta/Class.pm
index c4a78a3..5bf56a4 100644 (file)
--- a/lib/Moose/Meta/Class.pm
+++ b/lib/Moose/Meta/Class.pm
@@ -123,7 +123,7 @@ sub generate_delgate_method {
     # FIXME the reader may not work for subclasses with weird instances
 
     my $make = $method->{generator} || sub {
-        my ( $self, $attr, $method )  =@_;
+        my ( $self, $attr, $method ) = @_;
     
         my $method_name = $method->{name};
         my $reader = $attr->generate_reader_method();
@@ -372,3 +372,4 @@ This library is free software; you can redistribute it and/or modify
 it under the same terms as Perl itself. 
 
 =cut
+

diff --git a/t/032_attribute_accessor_generation.t b/t/032_attribute_accessor_generation.t
index 385134d..5bbc1fa 100644 (file)
--- a/t/032_attribute_accessor_generation.t
+++ b/t/032_attribute_accessor_generation.t
@@ -3,7 +3,7 @@
 use strict;
 use warnings;
 
-use Test::More tests => 33;
+use Test::More tests => 57;
 use Test::Exception;
 
 use Scalar::Util 'isweak';
@@ -58,6 +58,33 @@ BEGIN {
         );
     };
     ::ok(!$@, '... created the accessor method with weak_ref okay');    
+
+    eval {
+        has 'foo_deref' => (
+            accessor => 'foo_deref',
+            isa => 'ArrayRef',
+            auto_deref => 1,
+        );
+    };
+    ::ok(!$@, '... created the accessor method with auto_deref okay');    
+
+    eval {
+        has 'foo_deref_ro' => (
+            reader => 'foo_deref_ro',
+            isa => 'ArrayRef',
+            auto_deref => 1,
+        );
+    };
+    ::ok(!$@, '... created the reader method with auto_deref okay');    
+
+    eval {
+        has 'foo_deref_hash' => (
+            accessor => 'foo_deref_hash',
+            isa => 'HashRef',
+            auto_deref => 1,
+        );
+    };
+    ::ok(!$@, '... created the reader method with auto_deref okay');    
 }
 
 {
@@ -129,6 +156,54 @@ BEGIN {
     
     ok(isweak($foo->{foo_weak}), '... it is a weak reference');
 
+    can_ok( $foo, 'foo_deref');
+    is( $foo->foo_deref(), undef, '... unset value');
+    my @list;
+    lives_ok {
+        @list = $foo->foo_deref();
+    } "... doesn't deref undef value";
+    is_deeply( \@list, [], "returns empty list in list context");
+
+    lives_ok {
+        $foo->foo_deref( [ qw/foo bar gorch/ ] );
+    } '... foo_deref wrote successfully';
+
+    is( Scalar::Util::reftype( scalar $foo->foo_deref() ), "ARRAY", "returns an array reference in scalar context" );
+    is_deeply( scalar($foo->foo_deref()), [ qw/foo bar gorch/ ], "correct array" );
+
+    is( scalar( () = $foo->foo_deref() ), 3, "returns list in list context" );
+    is_deeply( [ $foo->foo_deref() ], [ qw/foo bar gorch/ ], "correct list" );
+
+
+    can_ok( $foo, 'foo_deref' );
+    is( $foo->foo_deref_ro(), undef, "... unset value" );
+
+    dies_ok {
+        $foo->foo_deref_ro( [] );
+    } "... read only";
+
+    $foo->{foo_deref_ro} = [qw/la la la/];
+
+    is_deeply( scalar($foo->foo_deref_ro()), [qw/la la la/], "scalar context ro" );
+    is_deeply( [ $foo->foo_deref_ro() ], [qw/la la la/], "list context ro" );
+
+    can_ok( $foo, 'foo_deref_hash' );
+    is( $foo->foo_deref_hash(), undef, "... unset value" );
+
+    my %hash;
+    lives_ok {
+        %hash = $foo->foo_deref_hash();
+    } "... doesn't deref undef value";
+    is_deeply( \%hash, {}, "returns empty list in list context");
+
+    lives_ok {
+        $foo->foo_deref_hash( { foo => 1, bar => 2 } );
+    } '... foo_deref_hash wrote successfully';
+
+    is_deeply( scalar($foo->foo_deref_hash), { foo => 1, bar => 2 }, "scalar context" );
+
+    %hash = $foo->foo_deref_hash;
+    is_deeply( \%hash, { foo => 1, bar => 2 }, "list context");
 }