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 override '_inline_instance_get' => sub {
  84     my $self = shift;
  85
  86     return $self->associated_class()
  87         ->inline_get_class_slot_value( $self->slots() );
  88 };
  89
  90
  91 override '_inline_weaken_value' => sub {
  92     my $self = shift;
  93     my ($instance, $value) = @_;
  94     return unless $self->is_weak_ref;
  95
  96     my $mi = $self->associated_class->get_meta_instance;
  97     return (
  98         $self->associated_class->inline_weaken_class_slot_value( $self->slots(), $value ),
  99             'if ref ' . $value . ';',
 100     );
 101 };
 102
 103 override '_inline_instance_set' => sub {
 104     my $self  = shift;
 105     shift;
 106     my $value = shift;
 107
 108     my $meta = $self->associated_class();
 109
 110     my $code
 111         = $meta->inline_set_class_slot_value( $self->slots(), $value ) . ";";
 112
 113     return $code;
 114 };
 115
 116 override '_inline_instance_has' => sub {
 117     my $self = shift;
 118
 119     return $self->associated_class()
 120         ->inline_is_class_slot_initialized( $self->slots() );
 121 };
 122
 123 override '_inline_clear_value' => sub {
 124     my $self = shift;
 125
 126     return $self->associated_class()
 127         ->inline_deinitialize_class_slot( $self->slots() );
 128 };
 129
 130 1;
 131
 132 # ABSTRACT: A trait for class attributes
 133
 134 __END__
 135
 136 =pod
 137
 138 =head1 DESCRIPTION
 139
 140 This role modifies the behavior of class attributes in various
 141 ways. It really should be a subclass of C<Moose::Meta::Attribute>, but
 142 if it were then it couldn't be combined with other attribute
 143 metaclasses, like C<MooseX::AttributeHelpers>.
 144
 145 There are no new public methods implemented by this role. All it does
 146 is change the behavior of a number of existing methods.
 147
 148 =head1 BUGS
 149
 150 See L<MooseX::ClassAttribute> for details.
 151
 152 =cut