move some anonymous class functionality further up the food chain and split out how...

[gitmo/Class-MOP.git] / lib / Class / MOP / Class.pm

diff --git a/lib/Class/MOP/Class.pm b/lib/Class/MOP/Class.pm
index a1de0c8..8807726 100644 (file)
--- a/lib/Class/MOP/Class.pm
+++ b/lib/Class/MOP/Class.pm
@@ -14,7 +14,7 @@ use Scalar::Util 'blessed', 'reftype', 'weaken';
 use Sub::Name    'subname';
 use Devel::GlobalDestruction 'in_global_destruction';
 
-our $VERSION   = '0.90';
+our $VERSION   = '0.91';
 $VERSION = eval $VERSION;
 our $AUTHORITY = 'cpan:STEVAN';
 
@@ -115,7 +115,8 @@ sub _new {
 
     return bless {
         # inherited from Class::MOP::Package
-        'package' => $options->{package},
+        'package'   => $options->{package},
+        'anonymous' => $options->{anonymous},
 
         # NOTE:
         # since the following attributes will
@@ -214,65 +215,23 @@ sub _check_metaclass_compatibility {
     }
 }
 
-## ANON classes
+# Anonymous Classes
 
-{
-    # NOTE:
-    # this should be sufficient, if you have a
-    # use case where it is not, write a test and
-    # I will change it.
-    my $ANON_CLASS_SERIAL = 0;
-
-    # NOTE:
-    # we need a sufficiently annoying prefix
-    # this should suffice for now, this is
-    # used in a couple of places below, so
-    # need to put it up here for now.
-    my $ANON_CLASS_PREFIX = 'Class::MOP::Class::__ANON__::SERIAL::';
-
-    sub is_anon_class {
-        my $self = shift;
-        no warnings 'uninitialized';
-        $self->name =~ /^$ANON_CLASS_PREFIX/o;
-    }
-
-    sub create_anon_class {
-        my ($class, %options) = @_;
-        my $package_name = $ANON_CLASS_PREFIX . ++$ANON_CLASS_SERIAL;
-        return $class->create($package_name, %options);
-    }
+sub is_anon_class {
+    return shift->is_anonymous;
+}
 
-    # NOTE:
-    # this will only get called for
-    # anon-classes, all other calls
-    # are assumed to occur during
-    # global destruction and so don't
-    # really need to be handled explicitly
-    sub DESTROY {
-        my $self = shift;
-
-        return if in_global_destruction(); # it'll happen soon anyway and this just makes things more complicated
-
-        no warnings 'uninitialized';
-        my $name = $self->name;
-        return unless $name =~ /^$ANON_CLASS_PREFIX/o;
-        # Moose does a weird thing where it replaces the metaclass for
-        # class when fixing metaclass incompatibility. In that case,
-        # we don't want to clean out the namespace now. We can detect
-        # that because Moose will explicitly update the singleton
-        # cache in Class::MOP.
-        my $current_meta = Class::MOP::get_metaclass_by_name($name);
-        return if $current_meta ne $self;
-
-        my ($serial_id) = ($name =~ /^$ANON_CLASS_PREFIX(\d+)/o);
-        no strict 'refs';
-        @{$name . '::ISA'} = ();
-        %{$name . '::'}    = ();
-        delete ${$ANON_CLASS_PREFIX}{$serial_id . '::'};
-
-        Class::MOP::remove_metaclass_by_name($name);
-    }
+sub anonymous_package_prefix { 'Class::MOP::Class::__ANON__::SERIAL' }
 
+sub create_anon_class {
+    my ($class, %options) = @_;
+    my $package_name = sprintf (
+        '%s::%s', 
+        Class::MOP::Class->anonymous_package_prefix(), 
+        Class::MOP::Class->anonymous_package_postfix()
+    );
+    $options{anonymous} = 1;
+    return $class->create($package_name, %options);
 }
 
 # creating classes with MOP ...
@@ -854,14 +813,14 @@ sub invalidate_meta_instance {
 
 sub has_attribute {
     my ($self, $attribute_name) = @_;
-    (defined $attribute_name && $attribute_name)
+    (defined $attribute_name)
         || confess "You must define an attribute name";
     exists $self->get_attribute_map->{$attribute_name};
 }
 
 sub get_attribute {
     my ($self, $attribute_name) = @_;
-    (defined $attribute_name && $attribute_name)
+    (defined $attribute_name)
         || confess "You must define an attribute name";
     return $self->get_attribute_map->{$attribute_name}
     # NOTE:
@@ -872,7 +831,7 @@ sub get_attribute {
 
 sub remove_attribute {
     my ($self, $attribute_name) = @_;
-    (defined $attribute_name && $attribute_name)
+    (defined $attribute_name)
         || confess "You must define an attribute name";
     my $removed_attribute = $self->get_attribute_map->{$attribute_name};
     return unless defined $removed_attribute;