anon-classes

diff --git a/Changes b/Changes
index ac0abd8..240ec62 100644 (file)
--- a/Changes
+++ b/Changes
@@ -1,5 +1,13 @@
 Revision history for Perl extension Class-MOP.
 
+0.25
+    * Class::MOP::Class
+      - added create_anon_class for creating anonymous classes
+        - added tests for this
+      - added get_all_metaclasses, get_all_metaclass_names
+        and get_all_metaclass_instances method to allow
+        access to all the cached metaclass objects.
+
 0.24 Tues. April 11, 2006
     * Class::MOP::Class
       - cleaned up how the before/after/around method 
@@ -16,7 +24,6 @@ Revision history for Perl extension Class-MOP.
            to them basically)
              - added tests for this
              - adjusted all /example files to comply 
-           
 
 0.22 Mon. March 20, 2006
     * Class::MOP::Class

diff --git a/MANIFEST b/MANIFEST
index 31a58ad..84c10da 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -32,6 +32,7 @@ t/014_attribute_introspection.t
 t/015_metaclass_inheritance.t
 t/016_class_errors_and_edge_cases.t
 t/017_add_method_modifier.t
+t/018_anon_class.t 
 t/020_attribute.t
 t/021_attribute_errors_and_edge_cases.t
 t/030_method.t

diff --git a/README b/README
index 571b592..6a69a03 100644 (file)
--- a/README
+++ b/README
@@ -1,4 +1,4 @@
-Class::MOP version 0.24
+Class::MOP version 0.25
 ===========================
 
 See the individual module documentation for more information

diff --git a/lib/Class/MOP.pm b/lib/Class/MOP.pm
index a510418..49cea2e 100644 (file)
--- a/lib/Class/MOP.pm
+++ b/lib/Class/MOP.pm
@@ -11,7 +11,7 @@ use Class::MOP::Class;
 use Class::MOP::Attribute;
 use Class::MOP::Method;
 
-our $VERSION = '0.24';
+our $VERSION = '0.25';
 
 ## ----------------------------------------------------------------------------
 ## Setting up our environment ...

diff --git a/lib/Class/MOP/Class.pm b/lib/Class/MOP/Class.pm
index 81aa4ea..2f4fbba 100644 (file)
--- a/lib/Class/MOP/Class.pm
+++ b/lib/Class/MOP/Class.pm
@@ -9,7 +9,7 @@ use Scalar::Util 'blessed', 'reftype';
 use Sub::Name    'subname';
 use B            'svref_2object';
 
-our $VERSION = '0.10';
+our $VERSION = '0.11';
 
 # Self-introspection 
 
@@ -22,7 +22,13 @@ sub meta { Class::MOP::Class->initialize(blessed($_[0]) || $_[0]) }
     # there is no need to worry about destruction though
     # because they should die only when the program dies.
     # After all, do package definitions even get reaped?
-    my %METAS;    
+    my %METAS;  
+    
+    # means of accessing all the metaclasses that have 
+    # been initialized thus far (for mugwumps obj browser)
+    sub get_all_metaclasses         {        %METAS }            
+    sub get_all_metaclass_instances { values %METAS } 
+    sub get_all_metaclass_names     { keys   %METAS }     
     
     sub initialize {
         my $class        = shift;
@@ -128,6 +134,13 @@ sub create {
     return $meta;
 }
 
+sub create_anon_class {
+    my ($class, %options) = @_;   
+    require Digest::MD5;
+    my $package_name = 'Class::MOP::Class::__ANON__::' . Digest::MD5::md5_hex({} . time() . $$ . rand());
+    return $class->create($package_name, '0.00', %options);
+}
+
 ## Attribute readers
 
 # NOTE:
@@ -652,6 +665,21 @@ bootstrap this module by installing a number of attribute meta-objects
 into it's metaclass. This will allow this class to reap all the benifits 
 of the MOP when subclassing it. 
 
+=item B<get_all_metaclasses>
+
+This will return an hash of all the metaclass instances that have 
+been cached by B<Class::MOP::Class> keyed by the package name. 
+
+=item B<get_all_metaclass_instances>
+
+This will return an array of all the metaclass instances that have 
+been cached by B<Class::MOP::Class>.
+
+=item B<get_all_metaclass_names>
+
+This will return an array of all the metaclass names that have 
+been cached by B<Class::MOP::Class>.
+
 =back
 
 =head2 Class construction
@@ -676,6 +704,14 @@ C<$package_name> into existence and adding any of the
 C<$package_version>, C<@superclasses>, C<%methods> and C<%attributes> 
 to it.
 
+=item B<create_anon_class (superclasses =E<gt> ?@superclasses, 
+                           methods      =E<gt> ?%methods, 
+                           attributes   =E<gt> ?%attributes)>
+
+This will create an anonymous class, it works much like C<create> but 
+it does not need a C<$package_name>. Instead it will create a suitably 
+unique package name for you to stash things into.
+
 =item B<initialize ($package_name)>
 
 This initializes and returns returns a B<Class::MOP::Class> object 

diff --git a/t/010_self_introspection.t b/t/010_self_introspection.t
index 9f5d9f2..1bd53cf 100644 (file)
--- a/t/010_self_introspection.t
+++ b/t/010_self_introspection.t
@@ -3,7 +3,7 @@
 use strict;
 use warnings;
 
-use Test::More tests => 126;
+use Test::More tests => 134;
 use Test::Exception;
 
 BEGIN {
@@ -22,7 +22,9 @@ isa_ok($meta, 'Class::MOP::Class');
 my @methods = qw(
     meta
     
-    initialize create
+    get_all_metaclasses get_all_metaclass_names get_all_metaclass_instances 
+    
+    initialize create create_anon_class
     
     new_object clone_object
     construct_instance construct_class_instance clone_instance

diff --git a/t/018_anon_class.t b/t/018_anon_class.t
new file mode 100644 (file)
index 0000000..57e900a
--- /dev/null
+++ b/t/018_anon_class.t
@@ -0,0 +1,37 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 7;
+use Test::Exception;
+
+BEGIN {
+    use_ok('Class::MOP');
+}
+
+my $anon_class = Class::MOP::Class->create_anon_class();
+isa_ok($anon_class, 'Class::MOP::Class');
+
+like($anon_class->name, qr/Class::MOP::Class::__ANON__::[0-9a-f]/, '... got an anon class package name');
+
+lives_ok {
+    $anon_class->add_method('foo' => sub { "__ANON__::foo" });
+} '... added a method to my anon-class';
+
+my $instance = $anon_class->new_object();
+isa_ok($instance, $anon_class->name);
+
+is($instance->foo, '__ANON__::foo', '... got the right return value of our foo method');
+
+# NOTE:
+# I bumped this test up to 100_000 instances, and 
+# still got not conflicts. If your application needs
+# more than that, your probably mst
+
+my %conflicts;
+foreach my $i (1 .. 1000) {
+    $conflicts{ Class::MOP::Class->create_anon_class()->name } = undef;
+}
+is(scalar(keys %conflicts), 1000, '... got as many classes as I would expect');
+