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

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