X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMooseX%2FClassAttribute.pm;h=d6170f920029aada300c19de0b2f66e989ea84f5;hb=170db2d9388d36d5c035510346f8aef7808c55dd;hp=1b5a0c64f567df62710b143027096db7c8e2c29d;hpb=4dee0fd36e42cb0e22e39a652bd931197a72ccc3;p=gitmo%2FMooseX-ClassAttribute.git diff --git a/lib/MooseX/ClassAttribute.pm b/lib/MooseX/ClassAttribute.pm index 1b5a0c6..d6170f9 100644 --- a/lib/MooseX/ClassAttribute.pm +++ b/lib/MooseX/ClassAttribute.pm @@ -1,9 +1,120 @@ package MooseX::ClassAttribute; -use warnings; use strict; +use warnings; + +our $VERSION = '0.03'; +our $AUTHORITY = 'cpan:DROLSKY'; + +our @EXPORT = 'class_has'; ## no critic ProhibitAutomaticExportation +use base 'Exporter'; + +use B qw( svref_2object ); +use Moose::Meta::Class; +use Sub::Name; + + +sub class_has ## no critic RequireArgUnpacking +{ + my $caller = caller(); + + process_class_attribute( $caller, @_ ); + + return; +} + +sub process_class_attribute ## no critic RequireArgUnpacking +{ + my $caller = shift; + + my $caller_meta = $caller->meta(); + + my @parents = $caller_meta->superclasses(); + + my $container_pkg = _make_container_class( $caller, @parents ); + my $container_meta = $container_pkg->meta(); + + $container_meta->_process_attribute(@_); + + for my $meth ( grep { $_ ne 'instance' } $container_meta->get_method_list() ) + { + next if $caller_meta->has_method($meth); + + my $sub = sub { shift; + my $instance = $container_pkg->instance(); + return $instance->$meth(@_); }; + + $caller_meta->add_method( $meth => $sub ); + } + + return; +} + +{ + # This should probably be an attribute of the metaclass, but that + # would require extending Moose::Meta::Class, which would conflict + # with anything else that wanted to do so as well (we need + # metaclass roles or something). + my %Name; + + sub _make_container_class ## no critic RequireArgUnpacking + { + my $caller = shift; + + return $Name{$caller} if $Name{$caller}; + + my @parents = map { container_class($_) || () } @_; + + push @parents, 'Moose::Object' + unless grep { $_->isa('Moose::Object') } @parents; + + my $container_pkg = 'MooseX::ClassAttribute::Container::' . $caller; + + my $instance_meth = sub { + no strict 'refs'; ## no critic ProhibitNoStrict + return ${ $container_pkg . '::Self' } ||= shift->new(@_); + }; + + my $class = + Moose::Meta::Class->create + ( $container_pkg => + superclasses => \@parents, + methods => { instance => $instance_meth }, + ); -our $VERSION = '0.01'; + return $Name{$caller} = $container_pkg; + } + + sub container_class + { + my $pkg = shift || caller(); + + return $Name{$pkg}; + } +} + +# This is basically copied from Moose.pm +sub unimport ## no critic RequireFinalReturn, RequireArgUnpacking +{ + my $caller = Moose::_get_caller(@_); + + no strict 'refs'; ## no critic ProhibitNoStrict + foreach my $name (@EXPORT) + { + if ( defined &{ $caller . '::' . $name } ) + { + my $keyword = \&{ $caller . '::' . $name }; + + my $pkg_name = + eval { svref_2object($keyword)->GV()->STASH()->NAME() }; + + next if $@; + next if $pkg_name ne __PACKAGE__; + + delete ${ $caller . '::' }{$name}; + } + } +} 1; @@ -14,24 +125,80 @@ __END__ =head1 NAME -MooseX::ClassAttribute - The fantastic new MooseX::ClassAttribute! - +MooseX::ClassAttribute - Declare class attributes Moose-style =head1 SYNOPSIS -Quick summary of what the module does. - -Perhaps a little code snippet. + package My::Class; + use Moose; use MooseX::ClassAttribute; - my $foo = MooseX::ClassAttribute->new; + class_has 'Cache' => + ( is => 'rw', + isa => 'HashRef', + default => sub { {} }, + ); + + __PACKAGE__->meta()->make_immutable(); + MooseX::ClassAttribute::containing_class()->meta()->make_immutable(); + + no Moose; + no MooseX::ClassAttribute; + + # then later ... + + My::Class->Cache()->{thing} = ...; + + +=head1 DESCRIPTION + +This module allows you to declare class attributes in exactly the same +way as you declare object attributes, except using C +instead of C. It is also possible to make these attributes +immutable (and faster) just as you can with normal Moose attributes. + +You can use any feature of Moose's attribute declarations, including +overriding a parent's attributes, delegation (C), and +attribute metaclasses, and it should just work. + +The accessors methods for class attribute may be called on the class +directly, or on objects of that class. Passing a class attribute to +the constructor will not set it. + +=head1 FUNCTIONS + +This class exports one function when you use it, C. This +works exactly like Moose's C, but it declares class attributes. + +One little nit is that if you include C in your class, you +won't remove the C function. To do that you must include +C as well. + +If you want to use this module to create class attributes in I +classes, you can call the C function like +this: + + MooseX::ClassAttribute::process_class_attribute( $package, ... ); + +The first argument is the package which will have the class attribute, +and the remaining arguments are the same as those passed to +C. + +=head2 Implementation and Immutability + +Underneath the hood, this class creates one new class for each class +which has class attributes and sets up delegating methods in the class +for which you're creating class attributes. You don't need to worry +about this too much, except when it comes to making a class immutable. - ... +Since the class attributes are not really stored in your class, you +need to make the containing class immutable as well as your own ... -=head1 METHODS + __PACKAGE__->meta()->make_immutable(); + MooseX::ClassAttribute::containing_class()->meta()->make_immutable(); -This class provides the following methods +I =head1 AUTHOR @@ -39,10 +206,10 @@ Dave Rolsky, C<< >> =head1 BUGS -Please report any bugs or feature requests to C, -or through the web interface at L. I will be -notified, and then you'll automatically be notified of progress on -your bug as I make changes. +Please report any bugs or feature requests to +C, or through the web interface +at L. I will be notified, and then you'll +automatically be notified of progress on your bug as I make changes. =head1 COPYRIGHT & LICENSE