From: Wallace Reis <reis.wallace@gmail.com>
Date: Wed, 2 Jul 2008 21:20:30 +0000 (+0000)
Subject: added legal_options_for_inheritance
X-Git-Tag: 0_55~59
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=aa08864cbdb0c4b017cdd5c241acd63e38429174;p=gitmo%2FMoose.git

added legal_options_for_inheritance
---

diff --git a/Changes b/Changes
index d57d754..560901e 100644
--- a/Changes
+++ b/Changes
@@ -1,6 +1,9 @@
 Revision history for Perl extension Moose
 
 0.52
+    * Moose::Meta::Attribute
+      - added legal_options_for_inheritance (wreis)
+
     * Moose::Cookbook::Snacks::*
       - removed some of the unfinished snacks that should 
         not have been released yet. Added some more examples
diff --git a/lib/Moose.pm b/lib/Moose.pm
index 9c14ff1..035168e 100644
--- a/lib/Moose.pm
+++ b/lib/Moose.pm
@@ -1034,6 +1034,8 @@ Sam (mugwump) Vilain
 
 Shawn (sartak) Moore
 
+Wallace (wreis) Reis
+
 ... and many other #moose folks
 
 =head1 COPYRIGHT AND LICENSE
diff --git a/lib/Moose/Meta/Attribute.pm b/lib/Moose/Meta/Attribute.pm
index 0fbc6af..a59d546 100644
--- a/lib/Moose/Meta/Attribute.pm
+++ b/lib/Moose/Meta/Attribute.pm
@@ -116,12 +116,17 @@ sub interpolate_class {
     return ( wantarray ? ( $class, @traits ) : $class );
 }
 
+# you can change default, required, coerce, documentation, lazy, handles, builder, type_constraint (explicitly or using isa/does), metaclass and traits
+sub legal_options_for_inheritance {
+  return qw(default coerce required documentation lazy handles builder
+    type_constraint);
+}
+
 sub clone_and_inherit_options {
     my ($self, %options) = @_;
     my %copy = %options;
-    # you can change default, required, coerce, documentation, lazy, handles, builder, type_constraint (explicitly or using isa/does), metaclass and traits
     my %actual_options;
-    foreach my $legal_option (qw(default coerce required documentation lazy handles builder type_constraint)) {
+    foreach my $legal_option ($self->legal_options_for_inheritance) {
         if (exists $options{$legal_option}) {
             $actual_options{$legal_option} = $options{$legal_option};
             delete $options{$legal_option};
@@ -741,6 +746,11 @@ This is to support the C<has '+foo'> feature, it clones an attribute
 from a superclass and allows a very specific set of changes to be made
 to the attribute.
 
+=item B<legal_options_for_inheritance>
+
+Whitelist with options you can change. You can overload it in your custom
+metaclass to allow your options be inheritable.
+
 =item B<has_type_constraint>
 
 Returns true if this meta-attribute has a type constraint.
diff --git a/t/020_attributes/022_legal_options_for_inheritance.t b/t/020_attributes/022_legal_options_for_inheritance.t
new file mode 100644
index 0000000..a391465
--- /dev/null
+++ b/t/020_attributes/022_legal_options_for_inheritance.t
@@ -0,0 +1,50 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+use Test::More tests => 3;
+
+BEGIN {
+    use_ok('Moose');
+}
+
+{
+    package Bar::Meta::Attribute;
+    use Moose;
+
+    extends 'Moose::Meta::Attribute';
+
+    has 'my_legal_option' => (
+      isa => 'CodeRef',
+      is => 'rw',
+    );
+
+    around legal_options_for_inheritance => sub {
+      return (shift->(@_), qw/my_legal_option/);
+    };
+
+    package Bar;
+    use Moose;
+
+    has 'bar' => (
+      metaclass       => 'Bar::Meta::Attribute',
+      my_legal_option => sub { 'Bar' }
+    );
+
+    package Bar::B;
+    use Moose;
+
+    extends 'Bar';
+
+    has '+bar' => (
+      my_legal_option => sub { 'Bar::B' }
+    );
+}
+
+my $bar_attr = Bar::B->meta->get_attribute('bar');
+my ($legal_option) = grep {
+  $_ eq 'my_legal_option'
+} $bar_attr->legal_options_for_inheritance;
+is($legal_option, 'my_legal_option',
+  '... added my_legal_option as legal option for inheritance' );
+is($bar_attr->my_legal_option->(), 'Bar::B', '... overloaded my_legal_option');