lib/MooseX/ClassAttribute/Meta/Method/Accessor.pm

   1 package MooseX::ClassAttribute::Meta::Method::Accessor;
   2
   3 use strict;
   4 use warnings;
   5
   6 our $VERSION   = '0.12';
   7
   8 use namespace::autoclean;
   9 use Moose;
  10
  11 extends 'Moose::Meta::Method::Accessor';
  12
  13 sub _generate_predicate_method_inline {
  14     my $attr = (shift)->associated_attribute;
  15
  16     my $code
  17         = eval 'sub {'
  18         . $attr->associated_class()
  19         ->inline_is_class_slot_initialized( $attr->name() ) . '}';
  20
  21     confess "Could not generate inline predicate because : $@" if $@;
  22
  23     return $code;
  24 }
  25
  26 sub _generate_clearer_method_inline {
  27     my $attr          = (shift)->associated_attribute;
  28     my $meta_instance = $attr->associated_class->instance_metaclass;
  29
  30     my $code
  31         = eval 'sub {'
  32         . $attr->associated_class()
  33         ->inline_deinitialize_class_slot( $attr->name() ) . '}';
  34
  35     confess "Could not generate inline clearer because : $@" if $@;
  36
  37     return $code;
  38 }
  39
  40 sub _inline_store {
  41     my $self = shift;
  42     shift;
  43     my $value = shift;
  44
  45     my $attr = $self->associated_attribute();
  46
  47     my $meta = $attr->associated_class();
  48
  49     my $code
  50         = $meta->inline_set_class_slot_value( $attr->slots(), $value ) . ";";
  51     $code
  52         .= $meta->inline_weaken_class_slot_value( $attr->slots(), $value )
  53         . ";"
  54         if $attr->is_weak_ref();
  55
  56     return $code;
  57 }
  58
  59 sub _inline_get {
  60     my $self = shift;
  61
  62     my $attr = $self->associated_attribute;
  63     my $meta = $attr->associated_class();
  64
  65     return $meta->inline_get_class_slot_value( $attr->slots() );
  66 }
  67
  68 sub _inline_access {
  69     my $self = shift;
  70
  71     my $attr = $self->associated_attribute;
  72     my $meta = $attr->associated_class();
  73
  74     return $meta->inline_class_slot_access( $attr->slots() );
  75 }
  76
  77 sub _inline_has {
  78     my $self = shift;
  79
  80     my $attr = $self->associated_attribute;
  81     my $meta = $attr->associated_class();
  82
  83     return $meta->inline_is_class_slot_initialized( $attr->slots() );
  84 }
  85
  86 sub _inline_init_slot {
  87     my $self = shift;
  88
  89     return $self->_inline_store( undef, $_[-1] );
  90 }
  91
  92 sub _inline_check_lazy {
  93     my $self = shift;
  94
  95     return $self->SUPER::_inline_check_lazy( q{'}
  96             . $self->associated_attribute()->associated_class()->name()
  97             . q{'} );
  98 }
  99
 100 sub _inline_get_old_value_for_trigger {
 101     my $self = shift;
 102
 103     my $attr = $self->associated_attribute();
 104     return '' unless $attr->has_trigger();
 105
 106     my $pred = $attr->associated_class()
 107         ->inline_is_class_slot_initialized( $attr->name() );
 108
 109     return
 110           'my @old = '
 111         . $pred . q{ ? }
 112         . $self->_inline_get()
 113         . q{ : ()} . ";\n";
 114
 115 }
 116
 117 1;
 118
 119 __END__
 120
 121 =pod
 122
 123 =head1 NAME
 124
 125 MooseX::ClassAttribute::Meta::Method::Accessor - Accessor method generation for class attributes
 126
 127 =head1 DESCRIPTION
 128
 129 This class overrides L<Moose::Meta::Method::Accessor> to do code
 130 generation properly for class attributes.
 131
 132 =head1 AUTHOR
 133
 134 Dave Rolsky, C<< <autarch@urth.org> >>
 135
 136 =head1 BUGS
 137
 138 See L<MooseX::ClassAttribute> for details.
 139
 140 =head1 COPYRIGHT & LICENSE
 141
 142 Copyright 2007-2010 Dave Rolsky, All Rights Reserved.
 143
 144 This program is free software; you can redistribute it and/or modify
 145 it under the same terms as Perl itself.
 146
 147 =cut