Mostly working implementation, but mixing with MX::AH isn't working

[gitmo/MooseX-ClassAttribute.git] / lib / MooseX / ClassAttribute / Meta / Attribute.pm

diff --git a/lib/MooseX/ClassAttribute/Meta/Attribute.pm b/lib/MooseX/ClassAttribute/Meta/Attribute.pm
new file mode 100644 (file)
index 0000000..c6fe316
--- /dev/null
+++ b/lib/MooseX/ClassAttribute/Meta/Attribute.pm
@@ -0,0 +1,124 @@
+package MooseX::ClassAttribute::Meta::Attribute;
+
+use strict;
+use warnings;
+
+use MooseX::ClassAttribute::Meta::Method::Accessor;
+
+use Moose;
+
+extends 'Moose::Meta::Attribute';
+
+
+sub accessor_metaclass { 'MooseX::ClassAttribute::Meta::Method::Accessor' }
+
+sub _process_options
+{
+    my $class   = shift;
+    my $name    = shift;
+    my $options = shift;
+
+    confess 'A class attribute cannot be required'
+        if $options->{required};
+
+    return $class->SUPER::_process_options( $name, $options );
+}
+
+sub attach_to_class
+{
+    my $self = shift;
+    my $meta = shift;
+
+    $self->SUPER::attach_to_class($meta);
+
+    $self->_initialize($meta)
+        unless $self->is_lazy();
+}
+
+sub detach_from_class
+{
+    my $self = shift;
+    my $meta = shift;
+
+    $self->clear_value($meta);
+
+    $self->SUPER::detach_from_class($meta);
+}
+
+sub _initialize
+{
+    my $self = shift;
+
+    if ( $self->has_default() )
+    {
+        $self->set_value( $self->default() );
+    }
+    elsif ( $self->has_builder() )
+    {
+        $self->set_value( $self->_call_builder() );
+    }
+}
+
+sub default
+{
+    my $self = shift;
+
+    my $default = $self->SUPER::default();
+
+    if ( $self->is_default_a_coderef() )
+    {
+        return $default->( $self->associated_class() );
+    }
+
+    return $default;
+}
+
+sub _call_builder
+{
+    my $self  = shift;
+    my $class = shift;
+
+    my $builder = $self->builder();
+
+    return $class->$builder()
+        if $class->can( $self->builder );
+
+    confess(  "$class does not support builder method '"
+            . $self->builder
+            . "' for attribute '"
+            . $self->name
+            . "'" );
+}
+
+sub set_value
+{
+    my $self  = shift;
+    my $value = shift;
+
+    $self->associated_class()->set_class_attribute_value( $self->name() => $value );
+}
+
+sub get_value
+{
+    my $self  = shift;
+
+    return $self->associated_class()->get_class_attribute_value( $self->name() );
+}
+
+sub has_value
+{
+    my $self  = shift;
+
+    return $self->associated_class()->has_class_attribute_value( $self->name() );
+}
+
+sub clear_value
+{
+    my $self  = shift;
+
+    return $self->associated_class()->clear_class_attribute_value( $self->name() );
+}
+
+no Moose;
+
+1;