X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FClass%2FMOP%2FAttribute.pm;h=671719dda75ebc654b528877cb1592f39c1ff3f6;hb=8bc3395f2fa441f9b763db7a2c268db91209d165;hp=6b7a24fdb8389cf6d77cfce70fdb04a9fd22801f;hpb=38bf2a2585e26a47c919fd4c286b7716acb51c00;p=gitmo%2FMoose.git

diff --git a/lib/Class/MOP/Attribute.pm b/lib/Class/MOP/Attribute.pm
index 6b7a24f..671719d 100644
--- a/lib/Class/MOP/Attribute.pm
+++ b/lib/Class/MOP/Attribute.pm
@@ -10,8 +10,6 @@ use Carp         'confess';
 use Scalar::Util 'blessed', 'weaken';
 use Try::Tiny;
 
-our $AUTHORITY = 'cpan:STEVAN';
-
 use base 'Class::MOP::Object', 'Class::MOP::Mixin::AttributeCore';
 
 # NOTE: (meta-circularity)
@@ -112,26 +110,26 @@ sub initialize_instance_slot {
     # attribute's default value (if it has one)
     if(defined $init_arg and exists $params->{$init_arg}){
         $self->_set_initial_slot_value(
-            $meta_instance, 
+            $meta_instance,
             $instance,
             $params->{$init_arg},
         );
-    } 
+    }
     elsif (exists $self->{'default'}) {
         $self->_set_initial_slot_value(
-            $meta_instance, 
+            $meta_instance,
             $instance,
             $self->default($instance),
         );
-    } 
+    }
     elsif (defined( my $builder = $self->{'builder'})) {
         if ($builder = $instance->can($builder)) {
             $self->_set_initial_slot_value(
-                $meta_instance, 
+                $meta_instance,
                 $instance,
                 $instance->$builder,
             );
-        } 
+        }
         else {
             confess(ref($instance)." does not support builder method '". $self->{'builder'} ."' for attribute '" . $self->name . "'");
         }
@@ -165,8 +163,8 @@ sub _make_initializer_writer_callback {
     };
 }
 
-sub get_read_method  { 
-    my $self   = shift;    
+sub get_read_method  {
+    my $self   = shift;
     my $reader = $self->reader || $self->accessor;
     # normal case ...
     return $reader unless ref $reader;
@@ -175,19 +173,19 @@ sub get_read_method  {
     return $name;
 }
 
-sub get_write_method { 
+sub get_write_method {
     my $self   = shift;
-    my $writer = $self->writer || $self->accessor; 
+    my $writer = $self->writer || $self->accessor;
     # normal case ...
     return $writer unless ref $writer;
     # the HASH ref case
     my ($name) = %$writer;
-    return $name;    
+    return $name;
 }
 
 sub get_read_method_ref {
     my $self = shift;
-    if ((my $reader = $self->get_read_method) && $self->associated_class) {   
+    if ((my $reader = $self->get_read_method) && $self->associated_class) {
         return $self->associated_class->get_method($reader);
     }
     else {
@@ -206,8 +204,8 @@ sub get_read_method_ref {
 }
 
 sub get_write_method_ref {
-    my $self = shift;    
-    if ((my $writer = $self->get_write_method) && $self->associated_class) {         
+    my $self = shift;
+    if ((my $writer = $self->get_write_method) && $self->associated_class) {
         return $self->associated_class->get_method($writer);
     }
     else {
@@ -356,20 +354,21 @@ sub accessor_metaclass { 'Class::MOP::Method::Accessor' }
 sub _process_accessors {
     my ($self, $type, $accessor, $generate_as_inline_methods) = @_;
 
-    my $method_ctx;
-
-    if ( my $ctx = $self->definition_context ) {
-        $method_ctx = { %$ctx };
-    }
+    my $method_ctx = { %{ $self->definition_context || {} } };
 
     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_ctx->{description} = $self->_accessor_description($name, $type);
+
         $method = $self->accessor_metaclass->wrap(
             $method,
+            attribute    => $self,
             package_name => $self->associated_class->name,
             name         => $name,
+            associated_metaclass => $self->associated_class,
             definition_context => $method_ctx,
         );
         $self->associate_method($method);
@@ -379,14 +378,7 @@ sub _process_accessors {
         my $inline_me = ($generate_as_inline_methods && $self->associated_class->instance_metaclass->is_inlinable);
         my $method;
         try {
-            if ( $method_ctx ) {
-                my $desc = "accessor $accessor";
-                if ( $accessor ne $self->name ) {
-                    $desc .= " of attribute " . $self->name;
-                }
-
-                $method_ctx->{description} = $desc;
-            }
+            $method_ctx->{description} = $self->_accessor_description($accessor, $type);
 
             $method = $self->accessor_metaclass->new(
                 attribute     => $self,
@@ -394,6 +386,7 @@ sub _process_accessors {
                 accessor_type => $type,
                 package_name  => $self->associated_class->name,
                 name          => $accessor,
+                associated_metaclass => $self->associated_class,
                 definition_context => $method_ctx,
             );
         }
@@ -405,6 +398,18 @@ sub _process_accessors {
     }
 }
 
+sub _accessor_description {
+    my $self = shift;
+    my ($name, $type) = @_;
+
+    my $desc = "$type " . $self->associated_class->name . "::$name";
+    if ( $name ne $self->name ) {
+        $desc .= " of attribute " . $self->name;
+    }
+
+    return $desc;
+}
+
 sub install_accessors {
     my $self   = shift;
     my $inline = shift;
@@ -619,8 +624,31 @@ attribute initialization use the writer:
       )
   );
 
-Your writer will need to examine C<@_> and determine under which
-context it is being called.
+Your writer (actually, a wrapper around the writer, using
+L<method modifications|Moose::Manual::MethodModifiers>) will need to examine
+C<@_> and determine under which
+context it is being called:
+
+  around 'some_attr' => sub {
+      my $orig = shift;
+      my $self = shift;
+      # $value is not defined if being called as a reader
+      # $setter and $attr are only defined if being called as an initializer
+      my ($value, $setter, $attr) = @_;
+
+      # the reader behaves normally
+      return $self->$orig if not @_;
+
+      # mutate $value as desired
+      # $value = <something($value);
+
+      # if called as an initializer, set the value and we're done
+      return $setter->($row) if $setter;
+
+      # otherwise, call the real writer with the new value
+      $self->$orig($row);
+  };
+
 
 =back
 
@@ -728,6 +756,8 @@ either a method name or a subroutine reference.
 
 =item B<< $attr->is_default_a_coderef >>
 
+=item B<< $attr->builder >>
+
 =item B<< $attr->default($instance) >>
 
 The C<$instance> argument is optional. If you don't pass it, the