use strict;
use warnings;
-our $VERSION = '0.03';
+our $VERSION = '0.05';
our $AUTHORITY = 'cpan:DROLSKY';
-our @EXPORT = 'class_has'; ## no critic ProhibitAutomaticExportation
-use base 'Exporter';
+use Moose ();
+use Moose::Exporter;
+use MooseX::ClassAttribute::Role::Meta::Class;
+use MooseX::ClassAttribute::Role::Meta::Attribute;
-use B qw( svref_2object );
-use Moose::Meta::Class;
-use Sub::Name;
+Moose::Exporter->setup_import_methods
+ ( with_caller => [ 'class_has' ] );
-sub class_has ## no critic RequireArgUnpacking
+sub init_meta
{
- my $caller = caller();
+ shift;
+ my %p = @_;
- process_class_attribute( $caller, @_ );
+ Moose->init_meta(%p);
- return;
+ return
+ Moose::Util::MetaRole::apply_metaclass_roles
+ ( for_class => $p{for_class},
+ metaclass_roles => [ 'MooseX::ClassAttribute::Role::Meta::Class' ],
+ );
}
-sub process_class_attribute ## no critic RequireArgUnpacking
+sub class_has
{
- my $caller = shift;
+ my $caller = shift;
+ my $name = shift;
+ my %options = @_;
- my $caller_meta = $caller->meta();
+ my $attrs = ref $name eq 'ARRAY' ? $name : [$name];
- 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;
+ Class::MOP::Class
+ ->initialize($caller)
+ ->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, 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;
__END__
);
__PACKAGE__->meta()->make_immutable();
- MooseX::ClassAttribute::containing_class()->meta()->make_immutable();
+ MooseX::ClassAttribute::container_class()->meta()->make_immutable();
no Moose;
no MooseX::ClassAttribute;
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.
-Own little nit is that if you include C<no Moose> in your class, you
+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.
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 ...
+need to make the container class immutable as well as your own ...
__PACKAGE__->meta()->make_immutable();
- MooseX::ClassAttribute::containing_class()->meta()->make_immutable();
+ MooseX::ClassAttribute::container_class()->meta()->make_immutable();
I<This may change in the future!>