From: Stevan Little <stevan.little@iinteractive.com>
Date: Sat, 24 Mar 2007 15:42:45 +0000 (+0000)
Subject: fixed handles
X-Git-Tag: 0_19~5
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=d022f632fd6a270c5a76667a2c2b50ae367ed359;p=gitmo%2FMoose.git

fixed handles
---

diff --git a/Changes b/Changes
index 731e8f1..e1ce698 100644
--- a/Changes
+++ b/Changes
@@ -8,6 +8,16 @@ Revision history for Perl extension Moose
       - added list_all_type_constraints and 
         list_all_builtin_type_constraints
         functions to facilitate introspection.
+    
+    * Moose::Meta::Attribute
+      - fixed regexp 'handles' declarations 
+        to build the list of delegated methods
+        correctly (and not override important 
+        things like &new)
+        - added tests and docs for this
+
+    * misc.
+      - added test for working with Module::Refresh 
 
 0.18 Sat. March 10, 2007
     ~~ Many, many documentation updates ~~
diff --git a/MANIFEST b/MANIFEST
index 1434e12..7ea63df 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -90,6 +90,8 @@ t/101_subtype_conflict_bug.t
 t/102_Moose_Object_error.t
 t/103_subclass_use_base_bug.t
 t/104_inline_reader_bug.t
+t/105_module_refresh_compat.t
+t/106_handles_foreign_class_bug.t
 t/201_example.t
 t/202_example_Moose_POOP.t
 t/203_example.t
diff --git a/lib/Moose.pm b/lib/Moose.pm
index e7c581e..be327e6 100644
--- a/lib/Moose.pm
+++ b/lib/Moose.pm
@@ -434,8 +434,7 @@ a read-only attribute.
 
 =item I<handles =E<gt> [ @handles ]>
 
-There is experimental support for attribute delegation using the C<handles> 
-option. More docs to come later.
+...
 
 =back
 
diff --git a/lib/Moose/Meta/Attribute.pm b/lib/Moose/Meta/Attribute.pm
index 6b64bde..d00d6ff 100644
--- a/lib/Moose/Meta/Attribute.pm
+++ b/lib/Moose/Meta/Attribute.pm
@@ -7,7 +7,7 @@ use warnings;
 use Scalar::Util 'blessed', 'weaken', 'reftype';
 use Carp         'confess';
 
-our $VERSION   = '0.09';
+our $VERSION   = '0.10';
 our $AUTHORITY = 'cpan:STEVAN';
 
 use Moose::Meta::Method::Accessor;
@@ -341,6 +341,13 @@ sub install_accessors {
             (!$associated_class->has_method($handle))
                 || confess "You cannot overwrite a locally defined method ($handle) with a delegation";
             
+            # NOTE:
+            # handles is not allowed to delegate
+            # any of these methods, as they will 
+            # override the ones in your class, which 
+            # is almost certainly not what you want.
+            next if $handle =~ /^BUILD|DEMOLISH$/ || Moose::Object->can($handle);
+            
             if ((reftype($method_to_call) || '') eq 'CODE') {
                 $associated_class->add_method($handle => $method_to_call);                
             }
@@ -374,7 +381,7 @@ sub _canonicalize_handles {
         ($self->has_type_constraint)
             || confess "Cannot delegate methods based on a RegExpr without a type constraint (isa)";
         return map  { ($_ => $_) } 
-               grep {  $handles  } $self->_get_delegate_method_list;
+               grep { /$handles/ } $self->_get_delegate_method_list;
     }
     elsif (ref($handles) eq 'CODE') {
         return $handles->($self, $self->_find_delegate_metaclass);
diff --git a/lib/Moose/Meta/Class.pm b/lib/Moose/Meta/Class.pm
index 1dc36aa..44cf326 100644
--- a/lib/Moose/Meta/Class.pm
+++ b/lib/Moose/Meta/Class.pm
@@ -9,7 +9,7 @@ use Class::MOP;
 use Carp         'confess';
 use Scalar::Util 'weaken', 'blessed', 'reftype';
 
-our $VERSION   = '0.10';
+our $VERSION   = '0.11';
 our $AUTHORITY = 'cpan:STEVAN';
 
 use Moose::Meta::Method::Overriden;
diff --git a/t/105_module_refresh_bug.t b/t/105_module_refresh_compat.t
similarity index 100%
rename from t/105_module_refresh_bug.t
rename to t/105_module_refresh_compat.t
diff --git a/t/106_handles_foreign_class_bug.t b/t/106_handles_foreign_class_bug.t
new file mode 100644
index 0000000..2554dd6
--- /dev/null
+++ b/t/106_handles_foreign_class_bug.t
@@ -0,0 +1,73 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 8;
+use Test::Exception;
+
+{
+    package Foo;
+
+    sub new { 
+        bless({}, 'Foo') 
+    }
+    
+    sub a { 'Foo::a' }
+}
+
+{
+    package Bar;
+    use Moose;
+
+    ::lives_ok {
+        has 'baz' => (
+            is      => 'ro',
+            isa     => 'Foo',
+            lazy    => 1,
+            default => sub { Foo->new() },
+            handles => qr/^a$/,
+        );
+    } '... can create the attribute with delegations';
+    
+}
+
+my $bar;
+lives_ok {
+    $bar = Bar->new;
+} '... created the object ok';
+isa_ok($bar, 'Bar');
+
+is($bar->a, 'Foo::a', '... got the right delgated value');
+
+{
+    package Baz;
+    use Moose;
+
+    ::lives_ok {
+        has 'bar' => (
+            is      => 'ro',
+            isa     => 'Foo',
+            lazy    => 1,
+            default => sub { Foo->new() },
+            handles => qr/.*/,
+        );
+    } '... can create the attribute with delegations';
+    
+}
+
+my $baz;
+lives_ok {
+    $baz = Baz->new;
+} '... created the object ok';
+isa_ok($baz, 'Baz');
+
+is($baz->a, 'Foo::a', '... got the right delgated value');
+
+
+
+
+
+
+
+