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

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