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     $self->initialize_instance_slot($meta, $meta->name);
  32 };
  33
  34 override set_initial_value => sub {
  35     my ($self, $instance, $value) = @_;
  36     $self->_set_initial_slot_value(
  37         $self,
  38         $instance,
  39         $value
  40     );
  41 };
  42
  43
  44 before 'detach_from_class' => sub {
  45     shift->clear_value(shift);
  46 };
  47
  48 sub set_slot_value { $_[0]->set_value($_[0], $_[3]) }
  49
  50 around 'set_value' => sub {
  51     shift;
  52     my $self = shift;
  53     shift;    # ignoring instance or class name
  54     my $value = shift;
  55     $self->associated_class()
  56         ->set_class_attribute_value( $self->name() => $value );
  57 };
  58
  59 around 'get_value' => sub {
  60     shift;
  61     my $self = shift;
  62
  63     return $self->associated_class()
  64         ->get_class_attribute_value( $self->name() );
  65 };
  66
  67 around 'has_value' => sub {
  68     shift;
  69     my $self = shift;
  70
  71     return $self->associated_class()
  72         ->has_class_attribute_value( $self->name() );
  73 };
  74
  75 around 'clear_value' => sub {
  76     shift;
  77     my $self = shift;
  78
  79     return $self->associated_class()
  80         ->clear_class_attribute_value( $self->name() );
  81 };
  82
  83
  84 sub _inline_instance_get {}
  85 sub inline_get {}
  86 around ['inline_get', '_inline_instance_get'] => sub {
  87     my ($orig, $self) = @_;
  88
  89     return $self->associated_class()
  90         ->inline_get_class_slot_value( $self->slots() );
  91 };
  92
  93 sub _inline_weaken_value {}
  94 around ['_inline_weaken_value'] => sub {
  95     my ($orig, $self, $instance, $value) = @_;
  96     return '' unless $self->is_weak_ref;
  97     return
  98         $self->associated_class->inline_weaken_class_slot_value( $self->slots() )
  99            . 'if ref ' . $value . ';';
 100 };
 101
 102 sub _inline_instance_set {}
 103 around ['_inline_instance_set'] => sub {
 104     my ($orig, $self, undef, $value) = @_;
 105
 106     my $meta = $self->associated_class();
 107
 108     my $code
 109         = $meta->inline_set_class_slot_value( $self->slots(), $value ) . ";";
 110
 111     return $code;
 112 };
 113
 114 sub inline_set {}
 115 around ['inline_set'] => sub {
 116     my ($orig, $self, undef, $value) = @_;
 117
 118     my $meta = $self->associated_class();
 119
 120     my $code
 121         = $meta->inline_set_class_slot_value( $self->slots(), $value ) . ";";
 122     $code
 123         .= $self->_inline_weaken_value( $self->slots(), $value );
 124
 125     return $code;
 126 };
 127
 128 sub _inline_instance_has {}
 129 sub inline_has {}
 130 around ['inline_has', '_inline_instance_has'] => sub {
 131     my ($orig, $self) = @_;
 132
 133     return $self->associated_class()
 134         ->inline_is_class_slot_initialized( $self->slots() );
 135 };
 136
 137 sub _inline_clear_value {}
 138 sub inline_clear {}
 139 around ['inline_clear', '_inline_clear_value'] => sub {
 140     my ($orig, $self) = @_;
 141
 142     return $self->associated_class()
 143         ->inline_deinitialize_class_slot( $self->slots() );
 144 };
 145
 146 1;
 147
 148 # ABSTRACT: A trait for class attributes
 149
 150 __END__
 151
 152 =pod
 153
 154 =head1 DESCRIPTION
 155
 156 This role modifies the behavior of class attributes in various
 157 ways. It really should be a subclass of C<Moose::Meta::Attribute>, but
 158 if it were then it couldn't be combined with other attribute
 159 metaclasses, like C<MooseX::AttributeHelpers>.
 160
 161 There are no new public methods implemented by this role. All it does
 162 is change the behavior of a number of existing methods.
 163
 164 =head1 BUGS
 165
 166 See L<MooseX::ClassAttribute> for details.
 167
 168 =cut