Everything works, with my uber hack of making the attribute bits a

[gitmo/MooseX-ClassAttribute.git] / lib / MooseX / ClassAttribute.pm

diff --git a/lib/MooseX/ClassAttribute.pm b/lib/MooseX/ClassAttribute.pm
index 8a0c4a2..fd5b3f9 100644 (file)
--- a/lib/MooseX/ClassAttribute.pm
+++ b/lib/MooseX/ClassAttribute.pm
@@ -3,110 +3,46 @@ package MooseX::ClassAttribute;
 use strict;
 use warnings;
 
-our $VERSION = '0.02';
+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 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 = @_;
 
-    my $caller_meta = $caller->meta();
+    Moose->init_meta(%p);
 
-    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;
+    return
+        Moose::Util::MetaRole::apply_metaclass_roles
+            ( for_class       => $p{for_class},
+              metaclass_roles => [ 'MooseX::ClassAttribute::Role::Meta::Class' ],
+            );
 }
 
+sub class_has
 {
-    # 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 },
-                );
+    my $caller  = shift;
+    my $name    = shift;
+    my %options = @_;
 
-        return $Name{$caller} = $container_pkg;
-    }
+    my $attrs = ref $name eq 'ARRAY' ? $name : [$name];
 
-    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};
-        }
-    }
+    Class::MOP::Class
+            ->initialize($caller)
+            ->add_class_attribute( $_, %options )
+                for @{ $attrs };
 }
 
-
 1;
 
 __END__
@@ -131,7 +67,7 @@ MooseX::ClassAttribute - Declare class attributes Moose-style
         );
 
     __PACKAGE__->meta()->make_immutable();
-    MooseX::ClassAttribute::containing_class()->meta()->make_immutable();
+    MooseX::ClassAttribute::container_class()->meta()->make_immutable();
 
     no Moose;
     no MooseX::ClassAttribute;
@@ -161,10 +97,20 @@ the constructor will not set it.
 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.
 
+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
@@ -173,10 +119,10 @@ 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 ...
+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!>