X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMooseX%2FClassAttribute.pm;h=4666903d26935db56a7e2427d5a8670f103e0306;hb=cd8784bb787360b59a0df1d8513633ce2bd593f4;hp=8a0c4a2c75cd42cdcd3a75f2c5fc68cb838bdf28;hpb=b4d972cdaa4e3cd41ce3b0b81331bba3818de5ec;p=gitmo%2FMooseX-ClassAttribute.git diff --git a/lib/MooseX/ClassAttribute.pm b/lib/MooseX/ClassAttribute.pm index 8a0c4a2..4666903 100644 --- a/lib/MooseX/ClassAttribute.pm +++ b/lib/MooseX/ClassAttribute.pm @@ -3,120 +3,60 @@ package MooseX::ClassAttribute; use strict; use warnings; -our $VERSION = '0.02'; -our $AUTHORITY = 'cpan:DROLSKY'; - -our @EXPORT = 'class_has'; ## no critic ProhibitAutomaticExportation -use base 'Exporter'; - -use B qw( svref_2object ); -use Sub::Name; - - -sub class_has ## no critic RequireArgUnpacking -{ - my $caller = caller(); - - my $caller_meta = $caller->meta(); - - my @parents = $caller_meta->superclasses(); - - my $container_pkg = _make_container_class( $caller, @parents ); - - $container_pkg->meta()->_process_attribute(@_); - - my $container_meta = $container_pkg->meta(); - 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 module doesn't really need these pragmas - this is just for the benefit +# of prereq scanning. +require namespace::clean 0.20; +require namespace::autoclean 0.11; + +use Moose 2.00 (); +use Moose::Exporter; +use Moose::Util; +use MooseX::ClassAttribute::Trait::Class; +use MooseX::ClassAttribute::Trait::Role; +use MooseX::ClassAttribute::Trait::Application::ToClass; +use MooseX::ClassAttribute::Trait::Application::ToRole; + +Moose::Exporter->setup_import_methods( + with_meta => ['class_has'], + class_metaroles => { + class => ['MooseX::ClassAttribute::Trait::Class'], + }, + role_metaroles => { + role => ['MooseX::ClassAttribute::Trait::Role'], + application_to_class => + ['MooseX::ClassAttribute::Trait::Application::ToClass'], + application_to_role => + ['MooseX::ClassAttribute::Trait::Application::ToRole'], + }, +); + +sub class_has { + my $meta = shift; + my $name = shift; + + my $attrs = ref $name eq 'ARRAY' ? $name : [$name]; + + my %options = ( definition_context => _caller_info(), @_ ); + + $meta->add_class_attribute( $_, %options ) for @{$attrs}; } -{ - # 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 }, - ); - - 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 -{ - my $caller = 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}; - } - } +# Copied from Moose::Util in 2.06 +sub _caller_info { + my $level = @_ ? ( $_[0] + 1 ) : 2; + my %info; + @info{qw(package file line)} = caller($level); + return \%info; } - 1; +# ABSTRACT: Declare class attributes Moose-style + __END__ =pod -=head1 NAME - -MooseX::ClassAttribute - Declare class attributes Moose-style - =head1 SYNOPSIS package My::Class; @@ -131,7 +71,6 @@ MooseX::ClassAttribute - Declare class attributes Moose-style ); __PACKAGE__->meta()->make_immutable(); - MooseX::ClassAttribute::containing_class()->meta()->make_immutable(); no Moose; no MooseX::ClassAttribute; @@ -140,49 +79,72 @@ MooseX::ClassAttribute - Declare class attributes Moose-style 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. +way as object attributes, using C instead of C. 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. +overriding a parent's attributes, delegation (C), attribute traits, +etc. All features should just work. The one exception is the "required" flag, +which is not allowed for class attributes. -The accessors methods for class attribute may be called on the class +The accessor 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. +the constructor will not set that attribute. =head1 FUNCTIONS This class exports one function when you use it, C. This works exactly like Moose's C, but it declares class attributes. -Own 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. +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. Or you can just use L +instead. =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. +This module will add a role to your class's metaclass, See +L for details. This role +provides introspection methods for class attributes. + +Class attributes themselves do the +L role. + +=head2 Cooperation with Metaclasses and Traits + +This module should work with most attribute metaclasses and traits, +but it's possible that conflicts could occur. This module has been +tested to work with Moose's native traits. -Since the class attributes are not really stored in your class, you -need to make the containing class immutable as well as your own ... +=head2 Class Attributes in Roles - __PACKAGE__->meta()->make_immutable(); - MooseX::ClassAttribute::containing_class()->meta()->make_immutable(); +You can add a class attribute to a role. When that role is applied to a class, +the class will have the relevant class attributes added. Note that attribute +defaults will be calculated when the class attribute is composed into the +class. -I +=head1 DONATIONS -=head1 AUTHOR +If you'd like to thank me for the work I've done on this module, +please consider making a "donation" to me via PayPal. I spend a lot of +free time creating free software, and would appreciate any support +you'd care to offer. -Dave Rolsky, C<< >> +Please note that B in order +for me to continue working on this particular software. I will +continue to do so, inasmuch as I have in the past, for as long as it +interests me. + +Similarly, a donation made in this way will probably not make me work +on this software much more, unless I get so many donations that I can +consider working on free software full time, which seems unlikely at +best. + +To donate, log into PayPal and send money to autarch@urth.org or use +the button on this page: +L =head1 BUGS @@ -191,11 +153,4 @@ 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 - -Copyright 2007 Dave Rolsky, All Rights Reserved. - -This program is free software; you can redistribute it and/or modify -it under the same terms as Perl itself. - =cut