lib/MooseX/ClassAttribute/Role/Meta/Attribute.pm

   1 package MooseX::ClassAttribute::Role::Meta::Attribute;
   2
   3 use strict;
   4 use warnings;
   5
   6 use MooseX::ClassAttribute::Meta::Method::Accessor;
   7
   8 use Moose::Role;
   9
  10 # This is the worst role evar! Really, this should be a subclass,
  11 # because it overrides a lot of behavior. However, as a subclass it
  12 # won't cooperate with _other_ subclasses like
  13 # MX::AttributeHelpers::Base.
  14
  15 around 'accessor_metaclass' => sub
  16 {
  17     return 'MooseX::ClassAttribute::Meta::Method::Accessor';
  18 };
  19
  20 around '_process_options' => sub
  21 {
  22     my $orig    = shift;
  23     my $class   = shift;
  24     my $name    = shift;
  25     my $options = shift;
  26
  27     confess 'A class attribute cannot be required'
  28         if $options->{required};
  29
  30     return $class->$orig( $name, $options );
  31 };
  32
  33 around attach_to_class => sub
  34 {
  35     my $orig = shift;
  36     my $self = shift;
  37     my $meta = shift;
  38
  39     $self->$orig($meta);
  40
  41     $self->_initialize($meta)
  42         unless $self->is_lazy();
  43 };
  44
  45 around 'detach_from_class' => sub
  46 {
  47     my $orig = shift;
  48     my $self = shift;
  49     my $meta = shift;
  50
  51     $self->clear_value($meta);
  52
  53     $self->$orig($meta);
  54 };
  55
  56 sub _initialize
  57 {
  58     my $self = shift;
  59
  60     if ( $self->has_default() )
  61     {
  62         $self->set_value( $self->default() );
  63     }
  64     elsif ( $self->has_builder() )
  65     {
  66         $self->set_value( $self->_call_builder() );
  67     }
  68 }
  69
  70 around 'default' => sub
  71 {
  72     my $orig = shift;
  73     my $self = shift;
  74
  75     my $default = $self->$orig();
  76
  77     if ( $self->is_default_a_coderef() )
  78     {
  79         return $default->( $self->associated_class() );
  80     }
  81
  82     return $default;
  83 };
  84
  85 around '_call_builder' => sub
  86 {
  87     shift;
  88     my $self  = shift;
  89     my $class = shift;
  90
  91     my $builder = $self->builder();
  92
  93     return $class->$builder()
  94         if $class->can( $self->builder );
  95
  96     confess(  "$class does not support builder method '"
  97             . $self->builder
  98             . "' for attribute '"
  99             . $self->name
 100             . "'" );
 101 };
 102
 103 around 'set_value' => sub
 104 {
 105     shift;
 106     my $self  = shift;
 107     my $value = shift;
 108
 109     $self->associated_class()->set_class_attribute_value( $self->name() => $value );
 110 };
 111
 112 around 'get_value' => sub
 113 {
 114     shift;
 115     my $self  = shift;
 116
 117     return $self->associated_class()->get_class_attribute_value( $self->name() );
 118 };
 119
 120 around 'has_value' => sub
 121 {
 122     shift;
 123     my $self  = shift;
 124
 125     return $self->associated_class()->has_class_attribute_value( $self->name() );
 126 };
 127
 128 around 'clear_value' => sub
 129 {
 130     shift;
 131     my $self  = shift;
 132
 133     return $self->associated_class()->clear_class_attribute_value( $self->name() );
 134 };
 135
 136 no Moose::Role;
 137
 138 1;