1 package MooseX::ClassAttribute;
7 our $AUTHORITY = 'cpan:DROLSKY';
9 our @EXPORT = 'class_has'; ## no critic ProhibitAutomaticExportation
12 use B qw( svref_2object );
16 sub class_has ## no critic RequireArgUnpacking
18 my $caller = caller();
20 my $caller_meta = $caller->meta();
22 my @parents = $caller_meta->superclasses();
24 my $container_pkg = _make_container_class( $caller, @parents );
26 my $has = $container_pkg->can('has');
29 my $container_meta = $container_pkg->meta();
30 for my $meth ( grep { $_ ne 'instance' } $container_meta->get_method_list() )
32 next if $caller_meta->has_method($meth);
34 my $sub = sub { shift;
35 my $instance = $container_pkg->instance();
36 return $instance->$meth(@_); };
38 $caller_meta->add_method( $meth => $sub );
45 # This should probably be an attribute of the metaclass, but that
46 # would require extending Moose::Meta::Class, which would conflict
47 # with anything else that wanted to do so as well (we need
48 # metaclass roles or something).
51 sub _make_container_class ## no critic RequireArgUnpacking
55 return $Name{$caller} if $Name{$caller};
57 my @parents = map { container_class($_) || () } @_;
59 my $container_pkg = 'MooseX::ClassAttribute::Container::' . $caller;
61 my $code = "package $container_pkg;\n";
62 $code .= "use Moose;\n\n";
66 $code .= "extends qw( @parents );\n";
74 return $Self ||= shift->new(@_);
79 eval $code; ## no critic ProhibitStringyEval
82 return $Name{$caller} = $container_pkg;
87 my $pkg = shift || caller();
93 # This is basically copied from Moose.pm
94 sub unimport ## no critic RequireFinalReturn
96 my $caller = caller();
98 no strict 'refs'; ## no critic ProhibitNoStrict
99 foreach my $name (@EXPORT)
101 if ( defined &{ $caller . '::' . $name } )
103 my $keyword = \&{ $caller . '::' . $name };
106 eval { svref_2object($keyword)->GV()->STASH()->NAME() };
109 next if $pkg_name ne __PACKAGE__;
111 delete ${ $caller . '::' }{$name};
125 MooseX::ClassAttribute - Declare class attributes Moose-style
132 use MooseX::ClassAttribute;
137 default => sub { {} },
140 __PACKAGE__->meta()->make_immutable();
141 MooseX::ClassAttribute::containing_class()->meta()->make_immutable();
144 no MooseX::ClassAttribute;
148 My::Class->Cache()->{thing} = ...;
153 This module allows you to declare class attributes in exactly the same
154 way as you declare object attributes, except using C<class_has()>
155 instead of C<has()>. It is also possible to make these attributes
156 immutable (and faster) just as you can with normal Moose attributes.
158 You can use any feature of Moose's attribute declarations, including
159 overriding a parent's attributes, delegation (C<handles>), and
160 attribute metaclasses, and it should just work.
162 The accessors methods for class attribute may be called on the class
163 directly, or on objects of that class. Passing a class attribute to
164 the constructor will not set it.
168 This class exports one function when you use it, C<class_has()>. This
169 works exactly like Moose's C<has()>, but it declares class attributes.
171 Own little nit is that if you include C<no Moose> in your class, you
172 won't remove the C<class_has()> function. To do that you must include
173 C<no MooseX::ClassAttribute> as well.
175 =head2 Implementation and Immutability
177 Underneath the hood, this class creates one new class for each class
178 which has class attributes and sets up delegating methods in the class
179 for which you're creating class attributes. You don't need to worry
180 about this too much, except when it comes to making a class immutable.
182 Since the class attributes are not really stored in your class, you
183 need to make the containing class immutable as well as your own ...
185 __PACKAGE__->meta()->make_immutable();
186 MooseX::ClassAttribute::containing_class()->meta()->make_immutable();
188 I<This may change in the future!>
192 Dave Rolsky, C<< <autarch@urth.org> >>
196 Please report any bugs or feature requests to
197 C<bug-moosex-classattribute@rt.cpan.org>, or through the web interface
198 at L<http://rt.cpan.org>. I will be notified, and then you'll
199 automatically be notified of progress on your bug as I make changes.
201 =head1 COPYRIGHT & LICENSE
203 Copyright 2007 Dave Rolsky, All Rights Reserved.
205 This program is free software; you can redistribute it and/or modify
206 it under the same terms as Perl itself.