XS versions of the most common readsers
[gitmo/Class-MOP.git] / lib / Class / MOP / Attribute.pm
index 520cd91..4be906d 100644 (file)
@@ -9,7 +9,7 @@ use Class::MOP::Method::Accessor;
 use Carp         'confess';
 use Scalar::Util 'blessed', 'weaken';
 
-our $VERSION   = '0.63';
+our $VERSION   = '0.65';
 our $AUTHORITY = 'cpan:STEVAN';
 
 use base 'Class::MOP::Object';
@@ -24,9 +24,12 @@ use base 'Class::MOP::Object';
 # meta-objects.
 #     - Ain't meta-circularity grand? :)
 sub new {
-    my $class   = shift;
-    my $name    = shift;
-    my %options = @_;
+    my ( $class, @args ) = @_;
+
+    unshift @args, "name" if @args % 2 == 1;
+    my %options = @args;
+
+    my $name = $options{name};
 
     (defined $name && $name)
         || confess "You must provide a name for the attribute";
@@ -47,26 +50,24 @@ sub new {
     if( $options{required} and not( defined($options{builder}) || defined($options{init_arg}) || exists $options{default} ) ) {
         confess("A required attribute must have either 'init_arg', 'builder', or 'default'");
     }
+
     bless {
-        '$!name'      => $name,
-        '$!accessor'  => $options{accessor},
-        '$!reader'    => $options{reader},
-        '$!writer'      => $options{writer},
-        '$!predicate'   => $options{predicate},
-        '$!clearer'     => $options{clearer},
-        '$!builder'     => $options{builder},
-        '$!init_arg'    => $options{init_arg},
-        '$!default'     => $options{default},
-        '$!initializer' => $options{initializer},        
+        'name'      => $name,
+        'accessor'  => $options{accessor},
+        'reader'    => $options{reader},
+        'writer'      => $options{writer},
+        'predicate'   => $options{predicate},
+        'clearer'     => $options{clearer},
+        'builder'     => $options{builder},
+        'init_arg'    => $options{init_arg},
+        'default'     => $options{default},
+        'initializer' => $options{initializer},        
         # keep a weakened link to the
         # class we are associated with
-        '$!associated_class' => undef,
+        'associated_class' => undef,
         # and a list of the methods
         # associated with this attr
-        '@!associated_methods' => [],
-        # NOTE:
-        # protect this from silliness
-        init_arg => undef,
+        'associated_methods' => [],
     } => $class;
 }
 
@@ -85,7 +86,8 @@ sub clone {
 
 sub initialize_instance_slot {
     my ($self, $meta_instance, $instance, $params) = @_;
-    my $init_arg = $self->{'$!init_arg'};
+    my $init_arg = $self->{'init_arg'};
+
     # try to fetch the init arg from the %params ...
 
     # if nothing was in the %params, we can use the
@@ -97,14 +99,14 @@ sub initialize_instance_slot {
             $params->{$init_arg},
         );
     } 
-    elsif (defined $self->{'$!default'}) {
+    elsif (defined $self->{'default'}) {
         $self->_set_initial_slot_value(
             $meta_instance, 
             $instance,
             $self->default($instance),
         );
     } 
-    elsif (defined( my $builder = $self->{'$!builder'})) {
+    elsif (defined( my $builder = $self->{'builder'})) {
         if ($builder = $instance->can($builder)) {
             $self->_set_initial_slot_value(
                 $meta_instance, 
@@ -113,7 +115,7 @@ sub initialize_instance_slot {
             );
         } 
         else {
-            confess(blessed($instance)." does not support builder method '". $self->{'$!builder'} ."' for attribute '" . $self->name . "'");
+            confess(blessed($instance)." does not support builder method '". $self->{'builder'} ."' for attribute '" . $self->name . "'");
         }
     }
 }
@@ -140,29 +142,29 @@ sub _set_initial_slot_value {
 # the next bunch of methods will get bootstrapped
 # away in the Class::MOP bootstrapping section
 
-sub name { $_[0]->{'$!name'} }
-
-sub associated_class   { $_[0]->{'$!associated_class'}   }
-sub associated_methods { $_[0]->{'@!associated_methods'} }
-
-sub has_accessor    { defined($_[0]->{'$!accessor'})     ? 1 : 0 }
-sub has_reader      { defined($_[0]->{'$!reader'})       ? 1 : 0 }
-sub has_writer      { defined($_[0]->{'$!writer'})       ? 1 : 0 }
-sub has_predicate   { defined($_[0]->{'$!predicate'})    ? 1 : 0 }
-sub has_clearer     { defined($_[0]->{'$!clearer'})      ? 1 : 0 }
-sub has_builder     { defined($_[0]->{'$!builder'})      ? 1 : 0 }
-sub has_init_arg    { defined($_[0]->{'$!init_arg'})     ? 1 : 0 }
-sub has_default     { defined($_[0]->{'$!default'})      ? 1 : 0 }
-sub has_initializer { defined($_[0]->{'$!initializer'})  ? 1 : 0 }
-
-sub accessor    { $_[0]->{'$!accessor'}    }
-sub reader      { $_[0]->{'$!reader'}      }
-sub writer      { $_[0]->{'$!writer'}      }
-sub predicate   { $_[0]->{'$!predicate'}   }
-sub clearer     { $_[0]->{'$!clearer'}     }
-sub builder     { $_[0]->{'$!builder'}     }
-sub init_arg    { $_[0]->{'$!init_arg'}    }
-sub initializer { $_[0]->{'$!initializer'} }
+sub name { $_[0]->{'name'} }
+
+sub associated_class   { $_[0]->{'associated_class'}   }
+sub associated_methods { $_[0]->{'associated_methods'} }
+
+sub has_accessor    { defined($_[0]->{'accessor'})     ? 1 : 0 }
+sub has_reader      { defined($_[0]->{'reader'})       ? 1 : 0 }
+sub has_writer      { defined($_[0]->{'writer'})       ? 1 : 0 }
+sub has_predicate   { defined($_[0]->{'predicate'})    ? 1 : 0 }
+sub has_clearer     { defined($_[0]->{'clearer'})      ? 1 : 0 }
+sub has_builder     { defined($_[0]->{'builder'})      ? 1 : 0 }
+sub has_init_arg    { defined($_[0]->{'init_arg'})     ? 1 : 0 }
+sub has_default     { defined($_[0]->{'default'})      ? 1 : 0 }
+sub has_initializer { defined($_[0]->{'initializer'})  ? 1 : 0 }
+
+sub accessor    { $_[0]->{'accessor'}    }
+sub reader      { $_[0]->{'reader'}      }
+sub writer      { $_[0]->{'writer'}      }
+sub predicate   { $_[0]->{'predicate'}   }
+sub clearer     { $_[0]->{'clearer'}     }
+sub builder     { $_[0]->{'builder'}     }
+sub init_arg    { $_[0]->{'init_arg'}    }
+sub initializer { $_[0]->{'initializer'} }
 
 # end bootstrapped away method section.
 # (all methods below here are kept intact)
@@ -231,7 +233,7 @@ sub get_write_method_ref {
 }
 
 sub is_default_a_coderef {
-    ('CODE' eq ref($_[0]->{'$!default'} || $_[0]->{default}))
+    ('CODE' eq ref($_[0]->{'default'} || $_[0]->{default}))
 }
 
 sub default {
@@ -241,9 +243,9 @@ sub default {
         # we pass in the instance and default
         # can return a value based on that
         # instance. Somewhat crude, but works.
-        return $self->{'$!default'}->($instance);
+        return $self->{'default'}->($instance);
     }
-    $self->{'$!default'};
+    $self->{'default'};
 }
 
 # slots
@@ -256,19 +258,19 @@ sub attach_to_class {
     my ($self, $class) = @_;
     (blessed($class) && $class->isa('Class::MOP::Class'))
         || confess "You must pass a Class::MOP::Class instance (or a subclass)";
-    weaken($self->{'$!associated_class'} = $class);
+    weaken($self->{'associated_class'} = $class);
 }
 
 sub detach_from_class {
     my $self = shift;
-    $self->{'$!associated_class'} = undef;
+    $self->{'associated_class'} = undef;
 }
 
 # method association
 
 sub associate_method {
     my ($self, $method) = @_;
-    push @{$self->{'@!associated_methods'}} => $method;
+    push @{$self->{'associated_methods'}} => $method;
 }
 
 ## Slot management
@@ -418,14 +420,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