X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FClass%2FMOP%2FMethod%2FAccessor.pm;h=0ecdca25435be363e648033425c70e6ba1480c6d;hb=94278c1ba6283af20c09a6aef615954825d08162;hp=9264eda3c750a20bd642cc412d5af9a8a7ba01ba;hpb=ba38bf08d30369c19a2c25997a0243c0d30be3d5;p=gitmo%2FClass-MOP.git

diff --git a/lib/Class/MOP/Method/Accessor.pm b/lib/Class/MOP/Method/Accessor.pm
index 9264eda..0ecdca2 100644
--- a/lib/Class/MOP/Method/Accessor.pm
+++ b/lib/Class/MOP/Method/Accessor.pm
@@ -7,84 +7,74 @@ use warnings;
 use Carp         'confess';
 use Scalar::Util 'blessed', 'weaken';
 
-our $VERSION   = '0.02';
+our $VERSION   = '0.65';
+$VERSION = eval $VERSION;
 our $AUTHORITY = 'cpan:STEVAN';
 
-use base 'Class::MOP::Method';
-
-=pod
-
-So, the idea here is that we have an accessor class
-which takes a weak-link to the attribute and can 
-generate the actual code ref needed. This might allow
-for more varied approaches.
-
-And if the attribute type can also declare what 
-kind of accessor method metaclass it uses, then 
-this relationship can be handled by delegation.
-
-=cut
+use base 'Class::MOP::Method::Generated';
 
 sub new {
     my $class   = shift;
     my %options = @_;
-    
+
     (exists $options{attribute})
         || confess "You must supply an attribute to construct with";
-        
+
     (exists $options{accessor_type})
-        || confess "You must supply an accessor_type to construct with"; 
-        
+        || confess "You must supply an accessor_type to construct with";
+
     (blessed($options{attribute}) && $options{attribute}->isa('Class::MOP::Attribute'))
-        || confess "You must supply an attribute which is a 'Class::MOP::Attribute' instance";    
-        
-    my $self = bless {
-        # from our superclass
-        body          => undef,
-        # specific to this subclass
-        attribute     => $options{attribute},
-        as_inline     => ($options{as_inline} || 0),
-        accessor_type => $options{accessor_type},        
-    } => $class;
-    
-    # we don't want this creating 
-    # a cycle in the code, if not 
+        || confess "You must supply an attribute which is a 'Class::MOP::Attribute' instance";
+
+    ($options{package_name} && $options{name})
+        || confess "You must supply the package_name and name parameters $Class::MOP::Method::UPGRADE_ERROR_TEXT";
+
+    my $self = $class->_new(\%options);
+
+    # we don't want this creating
+    # a cycle in the code, if not
     # needed
-    weaken($self->{attribute});
-    
-    $self->intialize_body;
-    
+    weaken($self->{'attribute'});
+
+    $self->initialize_body;
+
     return $self;
 }
 
+sub _new {
+    my $class = shift;
+    my $options = @_ == 1 ? $_[0] : {@_};
+
+    $options->{is_inline} ||= 0;
+
+    return bless $options, $class;
+}
+
 ## accessors
 
-sub associated_attribute { (shift)->{attribute}     }
-sub accessor_type        { (shift)->{accessor_type} }
-sub as_inline            { (shift)->{as_inline}     }
+sub associated_attribute { (shift)->{'attribute'}     }
+sub accessor_type        { (shift)->{'accessor_type'} }
 
-## factory 
+## factory
 
-sub intialize_body {
+sub initialize_body {
     my $self = shift;
-    
+
     my $method_name = join "_" => (
-        'generate', 
-        $self->accessor_type, 
+        'generate',
+        $self->accessor_type,
         'method',
-        ($self->as_inline ? 'inline' : ())
+        ($self->is_inline ? 'inline' : ())
     );
-    
-    eval {
-        $self->{body} = $self->$method_name();
-    };
+
+    eval { $self->{'body'} = $self->$method_name() };
     die $@ if $@;
 }
 
 ## generators
 
 sub generate_accessor_method {
-    my $attr = (shift)->associated_attribute; 
+    my $attr = (shift)->associated_attribute;
     return sub {
         $attr->set_value($_[0], $_[1]) if scalar(@_) == 2;
         $attr->get_value($_[0]);
@@ -92,37 +82,31 @@ sub generate_accessor_method {
 }
 
 sub generate_reader_method {
-    my $attr = (shift)->associated_attribute; 
-    return sub { 
+    my $attr = (shift)->associated_attribute;
+    return sub {
         confess "Cannot assign a value to a read-only accessor" if @_ > 1;
         $attr->get_value($_[0]);
-    };   
+    };
 }
 
 sub generate_writer_method {
-    my $attr = (shift)->associated_attribute; 
+    my $attr = (shift)->associated_attribute;
     return sub {
         $attr->set_value($_[0], $_[1]);
     };
 }
 
 sub generate_predicate_method {
-    my $attr      = (shift)->associated_attribute; 
-    my $attr_name = $attr->name;
-    return sub { 
-        defined Class::MOP::Class->initialize(Scalar::Util::blessed($_[0]))
-                                 ->get_meta_instance
-                                 ->get_slot_value($_[0], $attr_name) ? 1 : 0;
+    my $attr = (shift)->associated_attribute;
+    return sub {
+        $attr->has_value($_[0])
     };
 }
 
 sub generate_clearer_method {
-    my $attr      = (shift)->associated_attribute; 
-    my $attr_name = $attr->name;
-    return sub { 
-        Class::MOP::Class->initialize(Scalar::Util::blessed($_[0]))
-                         ->get_meta_instance
-                         ->deinitialize_slot($_[0], $attr_name);
+    my $attr = (shift)->associated_attribute;
+    return sub {
+        $attr->clear_value($_[0])
     };
 }
 
@@ -130,7 +114,7 @@ sub generate_clearer_method {
 
 
 sub generate_accessor_method_inline {
-    my $attr          = (shift)->associated_attribute; 
+    my $attr          = (shift)->associated_attribute;
     my $attr_name     = $attr->name;
     my $meta_instance = $attr->associated_class->instance_metaclass;
 
@@ -144,7 +128,7 @@ sub generate_accessor_method_inline {
 }
 
 sub generate_reader_method_inline {
-    my $attr          = (shift)->associated_attribute; 
+    my $attr          = (shift)->associated_attribute;
     my $attr_name     = $attr->name;
     my $meta_instance = $attr->associated_class->instance_metaclass;
 
@@ -158,7 +142,7 @@ sub generate_reader_method_inline {
 }
 
 sub generate_writer_method_inline {
-    my $attr          = (shift)->associated_attribute; 
+    my $attr          = (shift)->associated_attribute;
     my $attr_name     = $attr->name;
     my $meta_instance = $attr->associated_class->instance_metaclass;
 
@@ -172,12 +156,12 @@ sub generate_writer_method_inline {
 
 
 sub generate_predicate_method_inline {
-    my $attr          = (shift)->associated_attribute; 
+    my $attr          = (shift)->associated_attribute;
     my $attr_name     = $attr->name;
     my $meta_instance = $attr->associated_class->instance_metaclass;
 
-    my $code = eval 'sub {'
-        . 'defined ' . $meta_instance->inline_get_slot_value('$_[0]', "'$attr_name'") . ' ? 1 : 0'
+    my $code = eval 'sub {' .
+       $meta_instance->inline_is_slot_initialized('$_[0]', "'$attr_name'")
     . '}';
     confess "Could not generate inline predicate because : $@" if $@;
 
@@ -185,7 +169,7 @@ sub generate_predicate_method_inline {
 }
 
 sub generate_clearer_method_inline {
-    my $attr          = (shift)->associated_attribute; 
+    my $attr          = (shift)->associated_attribute;
     my $attr_name     = $attr->name;
     my $meta_instance = $attr->associated_class->instance_metaclass;
 
@@ -203,30 +187,85 @@ __END__
 
 =pod
 
-=head1 NAME 
+=head1 NAME
 
 Class::MOP::Method::Accessor - Method Meta Object for accessors
 
 =head1 SYNOPSIS
 
-  # ... more to come later maybe
+    use Class::MOP::Method::Accessor;
+
+    my $reader = Class::MOP::Method::Accessor->new(
+        attribute     => $attribute,
+        is_inline     => 1,
+        accessor_type => 'reader',
+    );
+
+    $reader->body->($instance); # call the reader method
 
 =head1 DESCRIPTION
 
+This is a C<Class::MOP::Method> subclass which is used interally
+by C<Class::MOP::Attribute> to generate accessor code. It can
+handle generation of readers, writers, predicate and clearer
+methods, both as closures and as more optimized inline methods.
+
 =head1 METHODS
 
 =over 4
 
-=item B<new>
+=item B<new (%options)>
+
+This creates the method based on the criteria in C<%options>,
+these options are:
+
+=over 4
+
+=item I<attribute>
+
+This must be an instance of C<Class::MOP::Attribute> which this
+accessor is being generated for. This paramter is B<required>.
+
+=item I<accessor_type>
+
+This is a string from the following set; reader, writer, accessor,
+predicate or clearer. This is used to determine which type of
+method is to be generated.
+
+=item I<is_inline>
+
+This is a boolean to indicate if the method should be generated
+as a closure, or as a more optimized inline version.
 
-=item B<intialize_body>
+=back
 
 =item B<accessor_type>
 
-=item B<as_inline>
+This returns the accessor type which was passed into C<new>.
+
+=item B<is_inline>
+
+This returns the boolean which was passed into C<new>.
 
 =item B<associated_attribute>
 
+This returns the attribute instance which was passed into C<new>.
+
+=item B<initialize_body>
+
+This will actually generate the method based on the specified
+criteria passed to the constructor.
+
+=back
+
+=head2 Method Generators
+
+These methods will generate appropriate code references for
+the various types of accessors which are supported by
+C<Class::MOP::Attribute>. The names pretty much explain it all.
+
+=over 4
+
 =item B<generate_accessor_method>
 
 =item B<generate_accessor_method_inline>
@@ -253,16 +292,14 @@ Class::MOP::Method::Accessor - Method Meta Object for accessors
 
 Stevan Little E<lt>stevan@iinteractive.comE<gt>
 
-Yuval Kogman E<lt>nothingmuch@woobling.comE<gt>
-
 =head1 COPYRIGHT AND LICENSE
 
-Copyright 2006 by Infinity Interactive, Inc.
+Copyright 2006-2008 by Infinity Interactive, Inc.
 
 L<http://www.iinteractive.com>
 
 This library is free software; you can redistribute it and/or modify
-it under the same terms as Perl itself. 
+it under the same terms as Perl itself.
 
 =cut