1 package MooseX::ClassAttribute;
7 our $AUTHORITY = 'cpan:DROLSKY';
9 our @EXPORT = 'class_has'; ## no critic ProhibitAutomaticExportation
10 use Exporter qw( import );
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.
164 This class exports one function when you use it, C<class_has()>. This
165 works exactly like Moose's C<has()>, but it declares class attributes.
167 Own little nit is that if you include C<no Moose> in your class, you
168 won't remove the C<class_has()> function. To do that you must include
169 C<no MooseX::ClassAttribute> as well.
171 =head2 Implementation and Immutability
173 Underneath the hood, this class creates one new class for each class
174 which has class attributes and sets up delegating methods in the class
175 for which you're creating class attributes. You don't need to worry
176 about this too much, except when it comes to making a class immutable.
178 Since the class attributes are not really stored in your class, you
179 need to make the containing class immutable as well as your own ...
181 __PACKAGE__->meta()->make_immutable();
182 MooseX::ClassAttribute::containing_class()->meta()->make_immutable();
184 I<This may change in the future!>
188 Dave Rolsky, C<< <autarch@urth.org> >>
192 Please report any bugs or feature requests to
193 C<bug-moosex-classattribute@rt.cpan.org>, or through the web interface
194 at L<http://rt.cpan.org>. I will be notified, and then you'll
195 automatically be notified of progress on your bug as I make changes.
197 =head1 COPYRIGHT & LICENSE
199 Copyright 2007 Dave Rolsky, All Rights Reserved.
201 This program is free software; you can redistribute it and/or modify
202 it under the same terms as Perl itself.