Begin updating to 0.62

[gitmo/Class-MOP.git] / lib / Class / MOP / Attribute.pm

diff --git a/lib/Class/MOP/Attribute.pm b/lib/Class/MOP/Attribute.pm
index 5d4994c..447fae3 100644 (file)
--- 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.62';
 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);
@@ -703,6 +727,14 @@ C<reader> and C<writer> or C<accessor> was specified or not.
 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