X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FClass%2FMOP%2FAttribute.pm;h=0a4fb6267a9bbb76b929e8e0158eeffb52b5d6ab;hb=f91a23dd94fbad5cee99c239a9cd5c45fce475b1;hp=31ff9a40bc60fe870280f25964360f5b76bdf4da;hpb=2e5a2a6225146cc29a9ad1a1ae8a70cdb06b0fa5;p=gitmo%2FClass-MOP.git

diff --git a/lib/Class/MOP/Attribute.pm b/lib/Class/MOP/Attribute.pm
index 31ff9a4..0a4fb62 100644
--- a/lib/Class/MOP/Attribute.pm
+++ b/lib/Class/MOP/Attribute.pm
@@ -7,18 +7,13 @@ use warnings;
 use Class::MOP::Method::Accessor;
 
 use Carp         'confess';
-use Scalar::Util 'blessed', 'reftype', 'weaken';
+use Scalar::Util 'blessed', 'weaken';
 
-our $VERSION   = '0.23';
+our $VERSION   = '0.64';
 our $AUTHORITY = 'cpan:STEVAN';
 
 use base 'Class::MOP::Object';
 
-sub meta {
-    require Class::MOP::Class;
-    Class::MOP::Class->initialize(blessed($_[0]) || $_[0]);
-}
-
 # NOTE: (meta-circularity)
 # This method will be replaced in the
 # boostrap section of Class::MOP, by
@@ -46,7 +41,7 @@ sub new {
     } else {
         (is_default_a_coderef(\%options))
             || confess("References are not allowed as default values, you must ".
-                       "wrap then in a CODE reference (ex: sub { [] } and not [])")
+                       "wrap the default of '$name' in a CODE reference (ex: sub { [] } and not [])")
                 if exists $options{default} && ref $options{default};
     }
     if( $options{required} and not( defined($options{builder}) || defined($options{init_arg}) || exists $options{default} ) ) {
@@ -172,6 +167,9 @@ sub initializer { $_[0]->{'$!initializer'} }
 # end bootstrapped away method section.
 # (all methods below here are kept intact)
 
+sub has_read_method  { $_[0]->has_reader || $_[0]->has_accessor }
+sub has_write_method { $_[0]->has_writer || $_[0]->has_accessor }
+
 sub get_read_method  { 
     my $self   = shift;    
     my $reader = $self->reader || $self->accessor;
@@ -198,7 +196,17 @@ sub get_read_method_ref {
         return $self->associated_class->get_method($reader);
     }
     else {
-        return sub { $self->get_value(@_) };
+        my $code = sub { $self->get_value(@_) };
+        if (my $class = $self->associated_class) {
+            return $class->method_metaclass->wrap(
+                $code,
+                package_name => $class->name,
+                name         => '__ANON__'
+            );
+        }
+        else {
+            return $code;
+        }
     }
 }
 
@@ -208,12 +216,22 @@ sub get_write_method_ref {
         return $self->associated_class->get_method($writer);
     }
     else {
-        return sub { $self->set_value(@_) };
+        my $code = sub { $self->set_value(@_) };
+        if (my $class = $self->associated_class) {
+            return $class->method_metaclass->wrap(
+                $code,
+                package_name => $class->name,
+                name         => '__ANON__'
+            );
+        }
+        else {
+            return $code;
+        }
     }
 }
 
 sub is_default_a_coderef {
-    ('CODE' eq (reftype($_[0]->{'$!default'} || $_[0]->{default}) || ''))
+    ('CODE' eq ref($_[0]->{'$!default'} || $_[0]->{default}))
 }
 
 sub default {
@@ -302,11 +320,15 @@ sub accessor_metaclass { 'Class::MOP::Method::Accessor' }
 
 sub process_accessors {
     my ($self, $type, $accessor, $generate_as_inline_methods) = @_;
-    if (reftype($accessor)) {
-        (reftype($accessor) eq 'HASH')
+    if (ref($accessor)) {
+        (ref($accessor) eq 'HASH')
             || confess "bad accessor/reader/writer/predicate/clearer format, must be a HASH ref";
         my ($name, $method) = %{$accessor};
-        $method = $self->accessor_metaclass->wrap($method);
+        $method = $self->accessor_metaclass->wrap(
+            $method,
+            package_name => $self->associated_class->name,
+            name         => $name,
+        );
         $self->associate_method($method);
         return ($name, $method);
     }
@@ -318,6 +340,8 @@ sub process_accessors {
                 attribute     => $self,
                 is_inline     => $inline_me,
                 accessor_type => $type,
+                package_name  => $self->associated_class->name,
+                name          => $accessor,
             );
         };
         confess "Could not create the '$type' method for " . $self->name . " because : $@" if $@;
@@ -357,7 +381,7 @@ sub install_accessors {
 {
     my $_remove_accessor = sub {
         my ($accessor, $class) = @_;
-        if (reftype($accessor) && reftype($accessor) eq 'HASH') {
+        if (ref($accessor) && ref($accessor) eq 'HASH') {
             ($accessor) = keys %{$accessor};
         }
         my $method = $class->get_method($accessor);
@@ -394,14 +418,14 @@ Class::MOP::Attribute - Attribute Meta Object
 
 =head1 SYNOPSIS
 
-  Class::MOP::Attribute->new('$foo' => (
+  Class::MOP::Attribute->new( foo => (
       accessor  => 'foo',        # dual purpose get/set accessor
       predicate => 'has_foo'     # predicate check for defined-ness
       init_arg  => '-foo',       # class->new will look for a -foo key
       default   => 'BAR IS BAZ!' # if no -foo key is provided, use this
   ));
 
-  Class::MOP::Attribute->new('$.bar' => (
+  Class::MOP::Attribute->new( bar => (
       reader    => 'bar',        # getter
       writer    => 'set_bar',    # setter
       predicate => 'has_bar'     # predicate check for defined-ness
@@ -444,7 +468,8 @@ value of C<-foo>, then the following code will Just Work.
   MyClass->meta->construct_instance(-foo => "Hello There");
 
 In an init_arg is not assigned, it will automatically use the
-value of C<$name>.
+value of C<$name>.  If an explicit C<undef> is given for an init_arg,
+an attribute value can't be specified during initialization.
 
 =item I<builder>
 
@@ -486,7 +511,7 @@ so:
 And lastly, if the value of your attribute is dependent upon
 some other aspect of the instance structure, then you can take
 advantage of the fact that when the I<default> value is a CODE
-reference, it is passed the raw (unblessed) instance structure
+reference, it is passed the (as yet unfinished) instance structure
 as it's only argument. So you can do things like this:
 
   Class::MOP::Attribute->new('$object_identity' => (
@@ -500,6 +525,37 @@ something you need, you could subclass B<Class::MOP::Class> and
 this class to acheive it. However, this is currently left as
 an exercise to the reader :).
 
+=item I<initializer>
+
+This may be a method name (referring to a method on the class with this
+attribute) or a CODE ref.  The initializer is used to set the attribute value
+on an instance when the attribute is set during instance initialization.  When
+called, it is passed the instance (as the invocant), the value to set, a
+slot-setting CODE ref, and the attribute meta-instance.  The slot-setting code
+is provided to make it easy to set the (possibly altered) value on the instance
+without going through several more method calls.
+
+This contrived example shows an initializer that sets the attribute to twice
+the given value.
+
+  Class::MOP::Attribute->new('$doubled' => (
+      initializer => sub {
+          my ($instance, $value, $set) = @_;
+          $set->($value * 2);
+      },
+  ));
+
+As method names can be given as initializers, one can easily make
+attribute initialization use the writer:
+
+  Class::MOP::Attribute->new('$some_attr' => (
+      writer      => 'some_attr',
+      initializer => 'some_attr',
+  ));
+
+Your writer will simply need to examine it's C<@_> and determine under
+which context it is being called.
+
 =back
 
 The I<accessor>, I<reader>, I<writer>, I<predicate> and I<clearer> keys can
@@ -556,7 +612,6 @@ value definedness, instead of presence as it is now.
 If you really want to get rid of the value, you have to define and 
 use a I<clearer> (see below).
 
-
 =item I<clearer>
 
 This is the a method that will uninitialize the attr, reverting lazy values
@@ -566,8 +621,15 @@ back to their "unfulfilled" state.
 
 =item B<clone (%options)>
 
+This will return a clone of the attribute instance, allowing the overriding
+of various attributes through the C<%options> supplied.
+
 =item B<initialize_instance_slot ($instance, $params)>
 
+This method is used internally to initialize the approriate slot for this 
+attribute in a given C<$instance>, the C<$params> passed are those that were
+passed to the constructor.
+
 =back
 
 =head2 Value management
@@ -662,9 +724,17 @@ Return the CODE reference of a method suitable for reading / writing the
 value of the attribute in the associated class. Suitable for use whether 
 C<reader> and C<writer> or C<accessor> was specified or not.
 
-NOTE: If not reader/writer/accessor was specified, this will use the 
+NOTE: If no reader/writer/accessor was specified, this will use the 
 attribute get_value/set_value methods, which can be very inefficient.
 
+=item B<has_read_method>
+
+=item B<has_write_method>
+
+Return whether a method exists suitable for reading / writing the value 
+of the attribute in the associated class. Suitable for use whether 
+C<reader> and C<writer> or C<accessor> was used.
+
 =back
 
 =head2 Informational predicates
@@ -741,7 +811,8 @@ used internally by the accessor generator.
 =item B<associated_methods>
 
 This will return the list of methods which have been associated with
-the C<associate_method> methods.
+the C<associate_method> methods. This is a good way of seeing what 
+methods are used to manage a given attribute. 
 
 =item B<install_accessors>
 
@@ -782,7 +853,7 @@ to this class.
 
 It should also be noted that B<Class::MOP> will actually bootstrap
 this module by installing a number of attribute meta-objects into
-it's metaclass. This will allow this class to reap all the benifits
+it's metaclass. This will allow this class to reap all the benefits
 of the MOP when subclassing it.
 
 =back