X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMooseX%2FClassAttribute%2FMeta%2FMethod%2FAccessor.pm;h=e446ee6c48c9b6f5f3582ad184a646386f1758a7;hb=b64c8efa3a64ace53507a9a2bb96090da56443c1;hp=2f6b0a67b197662b7429c548e9ef3277f0243ee0;hpb=0f24a39d98269d89db1b902d5c763124ce5fc797;p=gitmo%2FMooseX-ClassAttribute.git

diff --git a/lib/MooseX/ClassAttribute/Meta/Method/Accessor.pm b/lib/MooseX/ClassAttribute/Meta/Method/Accessor.pm
index 2f6b0a6..e446ee6 100644
--- a/lib/MooseX/ClassAttribute/Meta/Method/Accessor.pm
+++ b/lib/MooseX/ClassAttribute/Meta/Method/Accessor.pm
@@ -1,58 +1,133 @@
 package MooseX::ClassAttribute::Meta::Method::Accessor;
 
-use warnings;
 use strict;
-
-our $VERSION = '0.01';
-our $AUTHORITY = 'cpan:DROLSKY';
+use warnings;
 
 use Moose;
 
 extends 'Moose::Meta::Method::Accessor';
 
 
-sub _inline_store {
-    my $self     = shift;
-    my $instance = shift;
-    my $value    = shift;
+sub _generate_predicate_method_inline
+{
+    my $attr      = (shift)->associated_attribute;
 
-    my $attr = $self->associated_attribute();
+    my $code =
+        eval 'sub {'
+        . $attr->associated_class()->inline_is_class_slot_initialized( $attr->name() )
+        . '}';
+
+    confess "Could not generate inline predicate because : $@" if $@;
 
-    my $mi = $attr->associated_class()->get_meta_instance();
-    my $slot_name = $attr->slots();
+    return $code;
+}
 
-    my $package_var = sprintf q{$%s::__ClassAttribute{'%s'}}, $attr->associated_class()->name(), $slot_name;
+sub _generate_clearer_method_inline
+{
+    my $attr          = (shift)->associated_attribute;
+    my $meta_instance = $attr->associated_class->instance_metaclass;
 
-    my $code = "$package_var = $value;";
-    $code   .= "Scalar::Util::weaken $package_var;"
-        if $attr->is_weak_ref();
+    my $code =
+        eval 'sub {'
+        . $attr->associated_class()->inline_deinitialize_class_slot( $attr->name() )
+        . '}';
+
+    confess "Could not generate inline clearer because : $@" if $@;
 
     return $code;
 }
 
-sub _inline_get {
-    my $self     = shift;
-    my $instance = shift;
+sub _inline_store
+{
+    my $self  = shift;
+    shift;
+    my $value = shift;
 
     my $attr = $self->associated_attribute();
 
-    my $mi = $attr->associated_class()->get_meta_instance();
-    my $slot_name = $attr->slots();
+    my $meta = $attr->associated_class();
 
-    return sprintf q{$%s::__ClassAttribute{'%s'}}, $attr->associated_class()->name(), $slot_name;
+    my $code = $meta->inline_set_class_slot_value( $attr->slots(), $value )    . ";";
+    $code   .= $meta->inline_weaken_class_slot_value( $attr->slots(), $value ) . ";"
+        if $attr->is_weak_ref();
+
+    return $code;
 }
 
-sub generate_accessor_method {
-    shift->generate_accessor_method_inline(@_);
+sub _inline_get
+{
+    my $self  = shift;
+
+    my $attr = $self->associated_attribute;
+    my $meta = $attr->associated_class();
+
+    return $meta->inline_get_class_slot_value( $attr->slots() );
 }
 
-sub generate_reader_method {
-    shift->generate_reader_method_inline(@_);
+sub _inline_access
+{
+    my $self  = shift;
+
+    my $attr = $self->associated_attribute;
+    my $meta = $attr->associated_class();
+
+    return $meta->inline_class_slot_access( $attr->slots() );
 }
 
-sub generate_writer_method {
-    shift->generate_writer_method_inline(@_);
+sub _inline_has
+{
+    my $self = shift;
+
+    my $attr = $self->associated_attribute;
+    my $meta = $attr->associated_class();
+
+    return $meta->inline_is_class_slot_initialized( $attr->slots() );
 }
 
+sub _inline_init_slot
+{
+    my $self = shift;
+
+    return $self->_inline_store( undef, $_[-1] );
+}
+
+sub _inline_check_lazy
+{
+    my $self = shift;
+
+    return
+        $self->SUPER::_inline_check_lazy
+            ( q{'} . $self->associated_attribute()->associated_class()->name() . q{'} );
+}
+
+no Moose;
 
 1;
+
+=pod
+
+=head1 NAME
+
+MooseX::ClassAttribute::Meta::Method::Accessor - Accessor method generation for class attributes
+
+=head1 DESCRIPTION
+
+This class overrides L<Moose::Meta::Method::Accessor> to do code
+generation properly for class attributes.
+
+=head1 AUTHOR
+
+Dave Rolsky, C<< <autarch@urth.org> >>
+
+=head1 BUGS
+
+See L<MooseX::ClassAttribute> for details.
+
+=head1 COPYRIGHT & LICENSE
+
+Copyright 2007-2008 Dave Rolsky, All Rights Reserved.
+
+This program is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=cut