lib/MooseX/ClassAttribute/Trait/Attribute.pm

   1 package MooseX::ClassAttribute::Trait::Attribute;
   2
   3 use strict;
   4 use warnings;
   5
   6 use namespace::autoclean;
   7 use Moose::Role;
   8
   9 # This is the worst role evar! Really, this should be a subclass,
  10 # because it overrides a lot of behavior. However, as a subclass it
  11 # won't cooperate with _other_ subclasses.
  12
  13 around _process_options => sub {
  14     my $orig    = shift;
  15     my $class   = shift;
  16     my $name    = shift;
  17     my $options = shift;
  18
  19     confess 'A class attribute cannot be required'
  20         if $options->{required};
  21
  22     return $class->$orig( $name, $options );
  23 };
  24
  25 around attach_to_class => sub {
  26     my $orig = shift;
  27     my $self = shift;
  28     my $meta = shift;
  29
  30     $self->$orig($meta);
  31
  32     $self->_initialize($meta)
  33         unless $self->is_lazy();
  34 };
  35
  36 around detach_from_class => sub {
  37     my $orig = shift;
  38     my $self = shift;
  39     my $meta = shift;
  40
  41     $self->clear_value($meta);
  42
  43     $self->$orig($meta);
  44 };
  45
  46 sub _initialize {
  47     my $self      = shift;
  48     my $metaclass = shift;
  49
  50     if ( $self->has_default() ) {
  51         $self->set_value( undef, $self->default() );
  52     }
  53     elsif ( $self->has_builder() ) {
  54         $self->set_value( undef, $self->_call_builder( $metaclass->name() ) );
  55     }
  56 }
  57
  58 around default => sub {
  59     my $orig = shift;
  60     my $self = shift;
  61
  62     my $default = $self->$orig();
  63
  64     if ( $self->is_default_a_coderef() ) {
  65         return $default->( $self->associated_class() );
  66     }
  67
  68     return $default;
  69 };
  70
  71 around _call_builder => sub {
  72     shift;
  73     my $self  = shift;
  74     my $class = shift;
  75
  76     my $builder = $self->builder();
  77
  78     return $class->$builder()
  79         if $class->can( $self->builder );
  80
  81     confess(  "$class does not support builder method '"
  82             . $self->builder
  83             . "' for attribute '"
  84             . $self->name
  85             . "'" );
  86 };
  87
  88 around set_value => sub {
  89     shift;
  90     my $self = shift;
  91     shift;    # ignoring instance or class name
  92     my $value = shift;
  93
  94     $self->associated_class()
  95         ->set_class_attribute_value( $self->name() => $value );
  96 };
  97
  98 around get_value => sub {
  99     shift;
 100     my $self = shift;
 101
 102     return $self->associated_class()
 103         ->get_class_attribute_value( $self->name() );
 104 };
 105
 106 around has_value => sub {
 107     shift;
 108     my $self = shift;
 109
 110     return $self->associated_class()
 111         ->has_class_attribute_value( $self->name() );
 112 };
 113
 114 around clear_value => sub {
 115     shift;
 116     my $self = shift;
 117
 118     return $self->associated_class()
 119         ->clear_class_attribute_value( $self->name() );
 120 };
 121
 122 if ( $Moose::VERSION < 1.99 ) {
 123     around inline_get => sub {
 124         shift;
 125         my $self = shift;
 126
 127         return $self->associated_class()
 128             ->inline_get_class_slot_value( $self->slots() );
 129     };
 130
 131     around inline_set => sub {
 132         shift;
 133         my $self = shift;
 134         shift;
 135         my $value = shift;
 136
 137         my $meta = $self->associated_class();
 138
 139         my $code
 140             = $meta->inline_set_class_slot_value( $self->slots(), $value )
 141             . ";";
 142         $code
 143             .= $meta->inline_weaken_class_slot_value( $self->slots(), $value )
 144             . "    if ref $value;"
 145             if $self->is_weak_ref();
 146
 147         return $code;
 148     };
 149
 150     around inline_has => sub {
 151         shift;
 152         my $self = shift;
 153
 154         return $self->associated_class()
 155             ->inline_is_class_slot_initialized( $self->slots() );
 156     };
 157
 158     around inline_clear => sub {
 159         shift;
 160         my $self = shift;
 161
 162         return $self->associated_class()
 163             ->inline_deinitialize_class_slot( $self->slots() );
 164     };
 165 }
 166 else {
 167     around _inline_instance_get => sub {
 168         shift;
 169         my $self = shift;
 170
 171         return $self->associated_class()
 172             ->inline_get_class_slot_value( $self->slots() );
 173     };
 174
 175     around _inline_instance_set => sub {
 176         shift;
 177         my $self = shift;
 178         shift;
 179         my $value = shift;
 180
 181         return $self->associated_class()
 182             ->inline_set_class_slot_value( $self->slots(), $value );
 183     };
 184
 185     around _inline_instance_has => sub {
 186         shift;
 187         my $self = shift;
 188
 189         return $self->associated_class()
 190             ->inline_is_class_slot_initialized( $self->slots() );
 191     };
 192
 193     around _inline_instance_clear => sub {
 194         shift;
 195         my $self = shift;
 196
 197         return $self->associated_class()
 198             ->inline_deinitialize_class_slot( $self->slots() );
 199     };
 200
 201     around _inline_weaken_value => sub {
 202         shift;
 203         my $self = shift;
 204         shift;
 205         my $value = shift;
 206
 207         return unless $self->is_weak_ref();
 208
 209         return (
 210             $self->associated_class->inline_weaken_class_slot_value(
 211                 $self->slots(), $value
 212             ),
 213             'if ref ' . $value . ';',
 214         );
 215     };
 216 }
 217
 218 1;
 219
 220 # ABSTRACT: A trait for class attributes
 221
 222 __END__
 223
 224 =pod
 225
 226 =head1 DESCRIPTION
 227
 228 This role modifies the behavior of class attributes in various
 229 ways. It really should be a subclass of C<Moose::Meta::Attribute>, but
 230 if it were then it couldn't be combined with other attribute
 231 metaclasses, like C<MooseX::AttributeHelpers>.
 232
 233 There are no new public methods implemented by this role. All it does
 234 is change the behavior of a number of existing methods.
 235
 236 =head1 BUGS
 237
 238 See L<MooseX::ClassAttribute> for details.
 239
 240 =cut