1 package MooseX::ClassAttribute;
7 our $AUTHORITY = 'cpan:DROLSKY';
9 our @EXPORT = 'class_has'; ## no critic ProhibitAutomaticExportation
12 use B qw( svref_2object );
13 use Moose::Meta::Class;
17 sub class_has ## no critic RequireArgUnpacking
19 my $caller = caller();
21 process_class_attribute( $caller, @_ );
26 sub process_class_attribute ## no critic RequireArgUnpacking
30 my $caller_meta = $caller->meta();
32 my @parents = $caller_meta->superclasses();
34 my $container_pkg = _make_container_class( $caller, @parents );
35 my $container_meta = $container_pkg->meta();
37 $container_meta->add_attribute(@_);
39 for my $meth ( grep { $_ ne 'instance' } $container_meta->get_method_list() )
41 next if $caller_meta->has_method($meth);
43 my $sub = sub { shift;
44 my $instance = $container_pkg->instance();
45 return $instance->$meth(@_); };
47 $caller_meta->add_method( $meth => $sub );
54 # This should probably be an attribute of the metaclass, but that
55 # would require extending Moose::Meta::Class, which would conflict
56 # with anything else that wanted to do so as well (we need
57 # metaclass roles or something).
60 sub _make_container_class ## no critic RequireArgUnpacking
64 return $Name{$caller} if $Name{$caller};
66 my @parents = map { container_class($_) || () } @_;
68 push @parents, 'Moose::Object'
69 unless grep { $_->isa('Moose::Object') } @parents;
71 my $container_pkg = 'MooseX::ClassAttribute::Container::' . $caller;
72 my $instance_holder = $container_pkg . '::Self';
74 my $instance_meth = sub {
75 no strict 'refs'; ## no critic ProhibitNoStrict
76 return $$instance_holder ||= shift->new(@_);
80 Moose::Meta::Class->create
82 superclasses => \@parents,
83 methods => { instance => $instance_meth },
86 return $Name{$caller} = $container_pkg;
91 my $pkg = shift || caller();
97 # This is basically copied from Moose.pm
98 sub unimport ## no critic RequireFinalReturn, RequireArgUnpacking
100 my $caller = Moose::_get_caller(@_);
102 no strict 'refs'; ## no critic ProhibitNoStrict
103 foreach my $name (@EXPORT)
105 if ( defined &{ $caller . '::' . $name } )
107 my $keyword = \&{ $caller . '::' . $name };
110 eval { svref_2object($keyword)->GV()->STASH()->NAME() };
113 next if $pkg_name ne __PACKAGE__;
115 delete ${ $caller . '::' }{$name};
129 MooseX::ClassAttribute - Declare class attributes Moose-style
136 use MooseX::ClassAttribute;
141 default => sub { {} },
144 __PACKAGE__->meta()->make_immutable();
145 MooseX::ClassAttribute::container_class()->meta()->make_immutable();
148 no MooseX::ClassAttribute;
152 My::Class->Cache()->{thing} = ...;
157 This module allows you to declare class attributes in exactly the same
158 way as you declare object attributes, except using C<class_has()>
159 instead of C<has()>. It is also possible to make these attributes
160 immutable (and faster) just as you can with normal Moose attributes.
162 You can use any feature of Moose's attribute declarations, including
163 overriding a parent's attributes, delegation (C<handles>), and
164 attribute metaclasses, and it should just work.
166 The accessors methods for class attribute may be called on the class
167 directly, or on objects of that class. Passing a class attribute to
168 the constructor will not set it.
172 This class exports one function when you use it, C<class_has()>. This
173 works exactly like Moose's C<has()>, but it declares class attributes.
175 One little nit is that if you include C<no Moose> in your class, you
176 won't remove the C<class_has()> function. To do that you must include
177 C<no MooseX::ClassAttribute> as well.
179 If you want to use this module to create class attributes in I<other>
180 classes, you can call the C<process_class_attribute()> function like
183 MooseX::ClassAttribute::process_class_attribute( $package, ... );
185 The first argument is the package which will have the class attribute,
186 and the remaining arguments are the same as those passed to
189 =head2 Implementation and Immutability
191 Underneath the hood, this class creates one new class for each class
192 which has class attributes and sets up delegating methods in the class
193 for which you're creating class attributes. You don't need to worry
194 about this too much, except when it comes to making a class immutable.
196 Since the class attributes are not really stored in your class, you
197 need to make the container class immutable as well as your own ...
199 __PACKAGE__->meta()->make_immutable();
200 MooseX::ClassAttribute::container_class()->meta()->make_immutable();
202 I<This may change in the future!>
206 Dave Rolsky, C<< <autarch@urth.org> >>
210 Please report any bugs or feature requests to
211 C<bug-moosex-classattribute@rt.cpan.org>, or through the web interface
212 at L<http://rt.cpan.org>. I will be notified, and then you'll
213 automatically be notified of progress on your bug as I make changes.
215 =head1 COPYRIGHT & LICENSE
217 Copyright 2007 Dave Rolsky, All Rights Reserved.
219 This program is free software; you can redistribute it and/or modify
220 it under the same terms as Perl itself.