lib/MooseX/ClassAttribute/Meta/Attribute.pm

   1 package MooseX::ClassAttribute::Meta::Attribute;
   2
   3 use strict;
   4 use warnings;
   5
   6 use MooseX::ClassAttribute::Meta::Method::Accessor;
   7
   8 use Moose;
   9
  10 extends 'Moose::Meta::Attribute';
  11
  12
  13 sub accessor_metaclass { 'MooseX::ClassAttribute::Meta::Method::Accessor' }
  14
  15 sub _process_options
  16 {
  17     my $class   = shift;
  18     my $name    = shift;
  19     my $options = shift;
  20
  21     confess 'A class attribute cannot be required'
  22         if $options->{required};
  23
  24     return $class->SUPER::_process_options( $name, $options );
  25 }
  26
  27 sub attach_to_class
  28 {
  29     my $self = shift;
  30     my $meta = shift;
  31
  32     $self->SUPER::attach_to_class($meta);
  33
  34     $self->_initialize($meta)
  35         unless $self->is_lazy();
  36 }
  37
  38 sub detach_from_class
  39 {
  40     my $self = shift;
  41     my $meta = shift;
  42
  43     $self->clear_value($meta);
  44
  45     $self->SUPER::detach_from_class($meta);
  46 }
  47
  48 sub _initialize
  49 {
  50     my $self = shift;
  51
  52     if ( $self->has_default() )
  53     {
  54         $self->set_value( $self->default() );
  55     }
  56     elsif ( $self->has_builder() )
  57     {
  58         $self->set_value( $self->_call_builder() );
  59     }
  60 }
  61
  62 sub default
  63 {
  64     my $self = shift;
  65
  66     my $default = $self->SUPER::default();
  67
  68     if ( $self->is_default_a_coderef() )
  69     {
  70         return $default->( $self->associated_class() );
  71     }
  72
  73     return $default;
  74 }
  75
  76 sub _call_builder
  77 {
  78     my $self  = shift;
  79     my $class = shift;
  80
  81     my $builder = $self->builder();
  82
  83     return $class->$builder()
  84         if $class->can( $self->builder );
  85
  86     confess(  "$class does not support builder method '"
  87             . $self->builder
  88             . "' for attribute '"
  89             . $self->name
  90             . "'" );
  91 }
  92
  93 sub set_value
  94 {
  95     my $self  = shift;
  96     my $value = shift;
  97
  98     $self->associated_class()->set_class_attribute_value( $self->name() => $value );
  99 }
 100
 101 sub get_value
 102 {
 103     my $self  = shift;
 104
 105     return $self->associated_class()->get_class_attribute_value( $self->name() );
 106 }
 107
 108 sub has_value
 109 {
 110     my $self  = shift;
 111
 112     return $self->associated_class()->has_class_attribute_value( $self->name() );
 113 }
 114
 115 sub clear_value
 116 {
 117     my $self  = shift;
 118
 119     return $self->associated_class()->clear_class_attribute_value( $self->name() );
 120 }
 121
 122 no Moose;
 123
 124 1;