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;
73 my $instance_meth = sub {
74 no strict 'refs'; ## no critic ProhibitNoStrict
75 return ${ $container_pkg . '::Self' } ||= shift->new(@_);
79 Moose::Meta::Class->create
81 superclasses => \@parents,
82 methods => { instance => $instance_meth },
85 return $Name{$caller} = $container_pkg;
90 my $pkg = shift || caller();
96 # This is basically copied from Moose.pm
97 sub unimport ## no critic RequireFinalReturn, RequireArgUnpacking
99 my $caller = Moose::_get_caller(@_);
101 no strict 'refs'; ## no critic ProhibitNoStrict
102 foreach my $name (@EXPORT)
104 if ( defined &{ $caller . '::' . $name } )
106 my $keyword = \&{ $caller . '::' . $name };
109 eval { svref_2object($keyword)->GV()->STASH()->NAME() };
112 next if $pkg_name ne __PACKAGE__;
114 delete ${ $caller . '::' }{$name};
128 MooseX::ClassAttribute - Declare class attributes Moose-style
135 use MooseX::ClassAttribute;
140 default => sub { {} },
143 __PACKAGE__->meta()->make_immutable();
144 MooseX::ClassAttribute::containing_class()->meta()->make_immutable();
147 no MooseX::ClassAttribute;
151 My::Class->Cache()->{thing} = ...;
156 This module allows you to declare class attributes in exactly the same
157 way as you declare object attributes, except using C<class_has()>
158 instead of C<has()>. It is also possible to make these attributes
159 immutable (and faster) just as you can with normal Moose attributes.
161 You can use any feature of Moose's attribute declarations, including
162 overriding a parent's attributes, delegation (C<handles>), and
163 attribute metaclasses, and it should just work.
165 The accessors methods for class attribute may be called on the class
166 directly, or on objects of that class. Passing a class attribute to
167 the constructor will not set it.
171 This class exports one function when you use it, C<class_has()>. This
172 works exactly like Moose's C<has()>, but it declares class attributes.
174 One little nit is that if you include C<no Moose> in your class, you
175 won't remove the C<class_has()> function. To do that you must include
176 C<no MooseX::ClassAttribute> as well.
178 If you want to use this module to create class attributes in I<other>
179 classes, you can call the C<process_class_attribute()> function like
182 MooseX::ClassAttribute::process_class_attribute( $package, ... );
184 The first argument is the package which will have the class attribute,
185 and the remaining arguments are the same as those passed to
188 =head2 Implementation and Immutability
190 Underneath the hood, this class creates one new class for each class
191 which has class attributes and sets up delegating methods in the class
192 for which you're creating class attributes. You don't need to worry
193 about this too much, except when it comes to making a class immutable.
195 Since the class attributes are not really stored in your class, you
196 need to make the containing class immutable as well as your own ...
198 __PACKAGE__->meta()->make_immutable();
199 MooseX::ClassAttribute::containing_class()->meta()->make_immutable();
201 I<This may change in the future!>
205 Dave Rolsky, C<< <autarch@urth.org> >>
209 Please report any bugs or feature requests to
210 C<bug-moosex-classattribute@rt.cpan.org>, or through the web interface
211 at L<http://rt.cpan.org>. I will be notified, and then you'll
212 automatically be notified of progress on your bug as I make changes.
214 =head1 COPYRIGHT & LICENSE
216 Copyright 2007 Dave Rolsky, All Rights Reserved.
218 This program is free software; you can redistribute it and/or modify
219 it under the same terms as Perl itself.