lib/MooseX/ClassAttribute/Trait/Mixin/HasClassAttributes.pm

   1 package MooseX::ClassAttribute::Trait::Mixin::HasClassAttributes;
   2
   3 use strict;
   4 use warnings;
   5
   6 our $VERSION   = '0.12';
   7
   8 use namespace::autoclean;
   9 use Moose::Role;
  10
  11 has _class_attribute_map => (
  12     traits  => ['Hash'],
  13     is      => 'ro',
  14     isa     => 'HashRef[Class::MOP::Mixin::AttributeCore]',
  15     handles => {
  16         '_add_class_attribute'     => 'set',
  17         'has_class_attribute'      => 'exists',
  18         'get_class_attribute'      => 'get',
  19         '_remove_class_attribute'  => 'delete',
  20         'get_class_attribute_list' => 'keys',
  21     },
  22     default  => sub { {} },
  23     init_arg => undef,
  24 );
  25
  26 # deprecated
  27 sub get_class_attribute_map {
  28     return $_[0]->_class_attribute_map();
  29 }
  30
  31 sub add_class_attribute {
  32     my $self      = shift;
  33     my $attribute = shift;
  34
  35     ( $attribute->isa('Class::MOP::Mixin::AttributeCore') )
  36         || confess
  37         "Your attribute must be an instance of Class::MOP::Mixin::AttributeCore (or a subclass)";
  38
  39     $self->_attach_class_attribute($attribute);
  40
  41     my $attr_name = $attribute->name;
  42
  43     $self->remove_class_attribute($attr_name)
  44         if $self->has_class_attribute($attr_name);
  45
  46     my $order = ( scalar keys %{ $self->_attribute_map } );
  47     $attribute->_set_insertion_order($order);
  48
  49     $self->_add_class_attribute( $attr_name => $attribute );
  50
  51     # This method is called to allow for installing accessors. Ideally, we'd
  52     # use method overriding, but then the subclass would be responsible for
  53     # making the attribute, which would end up with lots of code
  54     # duplication. Even more ideally, we'd use augment/inner, but this is
  55     # Class::MOP!
  56     $self->_post_add_class_attribute($attribute)
  57         if $self->can('_post_add_class_attribute');
  58
  59     return $attribute;
  60 }
  61
  62 sub remove_class_attribute {
  63     my $self = shift;
  64     my $name = shift;
  65
  66     ( defined $name && $name )
  67         || confess 'You must provide an attribute name';
  68
  69     my $removed_attr = $self->get_class_attribute($name);
  70     return unless $removed_attr;
  71
  72     $self->_remove_class_attribute($name);
  73
  74     return $removed_attr;
  75 }
  76
  77 1;
  78
  79 __END__
  80
  81 =pod
  82
  83 =head1 NAME
  84
  85 MooseX::ClassAttribute::Trait::Mixin::HasClassAttributes - A mixin trait for things which have class attributes
  86
  87 =head1 DESCRIPTION
  88
  89 This trait is like L<Class::MOP::Mixin::HasAttributes>, except that it works
  90 with class attributes instead of object attributes.
  91
  92 See L<MooseX::ClassAttribute::Trait::Class> and
  93 L<MooseX::ClassAttribute::Trait::Role> for API details.
  94
  95 =head1 AUTHOR
  96
  97 Dave Rolsky, C<< <autarch@urth.org> >>
  98
  99 =head1 BUGS
 100
 101 See L<MooseX::ClassAttribute> for details.
 102
 103 =head1 COPYRIGHT & LICENSE
 104
 105 Copyright 2007-2010 Dave Rolsky, All Rights Reserved.
 106
 107 This program is free software; you can redistribute it and/or modify
 108 it under the same terms as Perl itself.
 109
 110 =cut