X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FClass%2FMOP%2FMethod%2FAccessor.pm;h=08bcbd179197fc7796ad3d1b669b80bb8a98ebd4;hb=5efa6a46982d17e1ff642e8b97673c6618fa7e6d;hp=6e402174433243525041dcddc3067841a29ee6af;hpb=da1bebb6a46a770cee8fe206b15998ba8db84e51;p=gitmo%2FClass-MOP.git

diff --git a/lib/Class/MOP/Method/Accessor.pm b/lib/Class/MOP/Method/Accessor.pm
index 6e40217..08bcbd1 100644
--- a/lib/Class/MOP/Method/Accessor.pm
+++ b/lib/Class/MOP/Method/Accessor.pm
@@ -6,8 +6,9 @@ use warnings;
 
 use Carp         'confess';
 use Scalar::Util 'blessed', 'weaken';
+use Try::Tiny;
 
-our $VERSION   = '0.78_02';
+our $VERSION   = '1.11';
 $VERSION = eval $VERSION;
 our $AUTHORITY = 'cpan:STEVAN';
 
@@ -43,11 +44,28 @@ sub new {
 
 sub _new {
     my $class = shift;
-    my $options = @_ == 1 ? $_[0] : {@_};
 
-    $options->{is_inline} ||= 0;
+    return Class::MOP::Class->initialize($class)->new_object(@_)
+        if $class ne __PACKAGE__;
 
-    return bless $options, $class;
+    my $params = @_ == 1 ? $_[0] : {@_};
+
+    return bless {
+        # inherited from Class::MOP::Method
+        body                 => $params->{body},
+        associated_metaclass => $params->{associated_metaclass},
+        package_name         => $params->{package_name},
+        name                 => $params->{name},
+        original_method      => $params->{original_method},
+
+        # inherit from Class::MOP::Generated
+        is_inline            => $params->{is_inline} || 0,
+        definition_context   => $params->{definition_context},
+
+        # defined in this class
+        attribute            => $params->{attribute},
+        accessor_type        => $params->{accessor_type},
+    } => $class;
 }
 
 ## accessors
@@ -57,12 +75,6 @@ sub accessor_type        { (shift)->{'accessor_type'} }
 
 ## factory
 
-sub initialize_body {
-    warn 'The initialize_body method has been made private.'
-        . " The public version is deprecated and will be removed in a future release.\n";
-    shift->_initialize_body;
-}
-
 sub _initialize_body {
     my $self = shift;
 
@@ -73,18 +85,11 @@ sub _initialize_body {
         ($self->is_inline ? 'inline' : ())
     );
 
-    eval { $self->{'body'} = $self->$method_name() };
-    die $@ if $@;
+    $self->{'body'} = $self->$method_name();
 }
 
 ## generators
 
-sub generate_accessor_method {
-    warn 'The generate_accessor_method method has been made private.'
-        . " The public version is deprecated and will be removed in a future release.\n";
-    shift->_generate_accessor_method;
-}
-
 sub _generate_accessor_method {
     my $attr = (shift)->associated_attribute;
     return sub {
@@ -93,12 +98,6 @@ sub _generate_accessor_method {
     };
 }
 
-sub generate_reader_method {
-    warn 'The generate_reader_method method has been made private.'
-        . " The public version is deprecated and will be removed in a future release.\n";
-    shift->_generate_reader_method;
-}
-
 sub _generate_reader_method {
     my $attr = (shift)->associated_attribute;
     return sub {
@@ -107,11 +106,6 @@ sub _generate_reader_method {
     };
 }
 
-sub generate_writer_method {
-    warn 'The generate_writer_method method has been made private.'
-        . " The public version is deprecated and will be removed in a future release.\n";
-    shift->_generate_writer_method;
-}
 
 sub _generate_writer_method {
     my $attr = (shift)->associated_attribute;
@@ -120,12 +114,6 @@ sub _generate_writer_method {
     };
 }
 
-sub generate_predicate_method {
-    warn 'The generate_predicate_method method has been made private.'
-        . " The public version is deprecated and will be removed in a future release.\n";
-    shift->_generate_predicate_method;
-}
-
 sub _generate_predicate_method {
     my $attr = (shift)->associated_attribute;
     return sub {
@@ -133,12 +121,6 @@ sub _generate_predicate_method {
     };
 }
 
-sub generate_clearer_method {
-    warn 'The generate_clearer_method method has been made private.'
-        . " The public version is deprecated and will be removed in a future release.\n";
-    shift->_generate_clearer_method;
-}
-
 sub _generate_clearer_method {
     my $attr = (shift)->associated_attribute;
     return sub {
@@ -148,120 +130,96 @@ sub _generate_clearer_method {
 
 ## Inline methods
 
-sub generate_accessor_method_inline {
-    warn 'The generate_accessor_method_inline method has been made private.'
-        . " The public version is deprecated and will be removed in a future release.\n";
-    shift->_generate_accessor_method_inline;
-}
-
 sub _generate_accessor_method_inline {
-    my $self          = shift;
-    my $attr          = $self->associated_attribute;
-    my $attr_name     = $attr->name;
-    my $meta_instance = $attr->associated_class->instance_metaclass;
-
-    my $code = $self->_eval_closure(
-        {},
-        'sub {'
-        . $meta_instance->inline_set_slot_value('$_[0]', $attr_name, '$_[1]')
-        . ' if scalar(@_) == 2; '
-        . $meta_instance->inline_get_slot_value('$_[0]', $attr_name)
-        . '}'
-    );
-    confess "Could not generate inline accessor because : $@" if $@;
+    my $self = shift;
+    my $attr = $self->associated_attribute;
+
+    my $code = try {
+        $self->_compile_code([
+            'sub {',
+                $attr->inline_set('$_[0]', '$_[1]'),
+                    'if scalar(@_) == 2;',
+                $attr->inline_get('$_[0]') . ';',
+            '}',
+        ]);
+    }
+    catch {
+        confess "Could not generate inline accessor because : $_";
+    };
 
     return $code;
 }
 
-sub generate_reader_method_inline {
-    warn 'The generate_reader_method_inline method has been made private.'
-        . " The public version is deprecated and will be removed in a future release.\n";
-    shift->_generate_reader_method_inline;
-}
-
 sub _generate_reader_method_inline {
-    my $self          = shift;
-    my $attr          = $self->associated_attribute;
-    my $attr_name     = $attr->name;
-    my $meta_instance = $attr->associated_class->instance_metaclass;
-
-     my $code = $self->_eval_closure(
-         {},
-        'sub {'
-        . 'confess "Cannot assign a value to a read-only accessor" if @_ > 1;'
-        . $meta_instance->inline_get_slot_value('$_[0]', $attr_name)
-        . '}'
-    );
-    confess "Could not generate inline reader because : $@" if $@;
+    my $self = shift;
+    my $attr = $self->associated_attribute;
+
+    my $code = try {
+        $self->_compile_code([
+            'sub {',
+                'confess "Cannot assign a value to a read-only accessor"',
+                    'if @_ > 1;',
+                $attr->inline_get('$_[0]') . ';',
+            '}',
+        ]);
+    }
+    catch {
+        confess "Could not generate inline reader because : $_";
+    };
 
     return $code;
 }
 
-sub generate_writer_method_inline {
-    warn 'The generate_writer_method_inline method has been made private.'
-        . " The public version is deprecated and will be removed in a future release.\n";
-    shift->_generate_writer_method_inline;
-}
-
 sub _generate_writer_method_inline {
-    my $self          = shift;
-    my $attr          = $self->associated_attribute;
-    my $attr_name     = $attr->name;
-    my $meta_instance = $attr->associated_class->instance_metaclass;
-
-    my $code = $self->_eval_closure(
-        {},
-        'sub {'
-        . $meta_instance->inline_set_slot_value('$_[0]', $attr_name, '$_[1]')
-        . '}'
-    );
-    confess "Could not generate inline writer because : $@" if $@;
+    my $self = shift;
+    my $attr = $self->associated_attribute;
+
+    my $code = try {
+        $self->_compile_code([
+            'sub {',
+                $attr->inline_set('$_[0]', '$_[1]') . ';',
+            '}',
+        ]);
+    }
+    catch {
+        confess "Could not generate inline writer because : $_";
+    };
 
     return $code;
 }
 
-sub generate_predicate_method_inline {
-    warn 'The generate_predicate_method_inline method has been made private.'
-        . " The public version is deprecated and will be removed in a future release.\n";
-    shift->_generate_predicate_method_inline;
-}
-
 sub _generate_predicate_method_inline {
-    my $self          = shift;
-    my $attr          = $self->associated_attribute;
-    my $attr_name     = $attr->name;
-    my $meta_instance = $attr->associated_class->instance_metaclass;
-
-    my $code = $self->_eval_closure(
-        {},
-       'sub {'
-       . $meta_instance->inline_is_slot_initialized('$_[0]', $attr_name)
-       . '}'
-    );
-    confess "Could not generate inline predicate because : $@" if $@;
+    my $self = shift;
+    my $attr = $self->associated_attribute;
+
+    my $code = try {
+        $self->_compile_code([
+            'sub {',
+                $attr->inline_has('$_[0]') . ';',
+            '}',
+        ]);
+    }
+    catch {
+        confess "Could not generate inline predicate because : $_";
+    };
 
     return $code;
 }
 
-sub generate_clearer_method_inline {
-    warn 'The generate_clearer_method_inline method has been made private.'
-        . " The public version is deprecated and will be removed in a future release.\n";
-    shift->_generate_clearer_method_inline;
-}
-
 sub _generate_clearer_method_inline {
-    my $self          = shift;
-    my $attr          = $self->associated_attribute;
-    my $attr_name     = $attr->name;
-    my $meta_instance = $attr->associated_class->instance_metaclass;
-
-    my $code = $self->_eval_closure(
-        {},
-        'sub {'
-        . $meta_instance->inline_deinitialize_slot('$_[0]', $attr_name)
-        . '}'
-    );
-    confess "Could not generate inline clearer because : $@" if $@;
+    my $self = shift;
+    my $attr = $self->associated_attribute;
+
+    my $code = try {
+        $self->_compile_code([
+            'sub {',
+                $attr->inline_clear('$_[0]') . ';',
+            '}',
+        ]);
+    }
+    catch {
+        confess "Could not generate inline clearer because : $_";
+    };
 
     return $code;
 }
@@ -290,7 +248,7 @@ Class::MOP::Method::Accessor - Method Meta Object for accessors
 
 =head1 DESCRIPTION
 
-This is a subclass of <Class::MOP::Method> which is used by
+This is a subclass of C<Class::MOP::Method> which is used by
 C<Class::MOP::Attribute> to generate accessor code. It handles
 generation of readers, writers, predicates and clearers. For each type
 of method, it can either create a subroutine reference, or actually
@@ -359,7 +317,7 @@ Stevan Little E<lt>stevan@iinteractive.comE<gt>
 
 =head1 COPYRIGHT AND LICENSE
 
-Copyright 2006-2009 by Infinity Interactive, Inc.
+Copyright 2006-2010 by Infinity Interactive, Inc.
 
 L<http://www.iinteractive.com>