package MooseX::ClassAttribute;
-use warnings;
use strict;
+use warnings;
-our $VERSION = '0.01';
+our $VERSION = '0.04';
our $AUTHORITY = 'cpan:DROLSKY';
-use Moose;
-use MooseX::ClassAttribute::Meta::Method::Accessor;
+our @EXPORT = 'class_has'; ## no critic ProhibitAutomaticExportation
+use base 'Exporter';
-extends 'Moose::Meta::Attribute';
+use B qw( svref_2object );
+use Moose::Meta::Class;
+use Sub::Name;
-sub accessor_metaclass { 'MooseX::ClassAttribute::Meta::Method::Accessor' }
-# This is called when an object is constructed.
-sub initialize_instance_slot
+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->add_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($_) || () } @_;
-# This is the bit of magic that lets you specify the metaclass as
-# 'ClassAttribute', rather than the full name, when creating an
-# attribute.
-package Moose::Meta::Attribute::Custom::ClassAttribute;
+ push @parents, 'Moose::Object'
+ unless grep { $_->isa('Moose::Object') } @parents;
-sub register_implementation { 'MooseX::ClassAttribute' }
+ my $container_pkg = 'MooseX::ClassAttribute::Container::' . $caller;
+ my $instance_holder = $container_pkg . '::Self';
+
+ my $instance_meth = sub {
+ no strict 'refs'; ## no critic ProhibitNoStrict
+ return $$instance_holder ||= 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, 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;
=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::container_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<class_has()>
+instead of C<has()>. 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<handles>), 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<class_has()>. This
+works exactly like Moose's C<has()>, but it declares class attributes.
+
+One little nit is that if you include C<no Moose> in your class, you
+won't remove the C<class_has()> function. To do that you must include
+C<no MooseX::ClassAttribute> as well.
+
+If you want to use this module to create class attributes in I<other>
+classes, you can call the C<process_class_attribute()> 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<class_has()>.
+
+=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 container class immutable as well as your own ...
-=head1 METHODS
+ __PACKAGE__->meta()->make_immutable();
+ MooseX::ClassAttribute::container_class()->meta()->make_immutable();
-This class provides the following methods
+I<This may change in the future!>
=head1 AUTHOR
=head1 BUGS
-Please report any bugs or feature requests to C<bug-moosex-classattribute@rt.cpan.org>,
-or through the web interface at L<http://rt.cpan.org>. 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<bug-moosex-classattribute@rt.cpan.org>, or through the web interface
+at L<http://rt.cpan.org>. I will be notified, and then you'll
+automatically be notified of progress on your bug as I make changes.
=head1 COPYRIGHT & LICENSE
projects / gitmo/MooseX-ClassAttribute.git / blobdiff