From: Stevan Little Date: Tue, 18 Apr 2006 02:49:55 +0000 (+0000) Subject: anon-classes X-Git-Tag: 0_26~16 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=587aca2327241221ca99551fbb2c4b0035888ef7;p=gitmo%2FClass-MOP.git anon-classes --- diff --git a/Changes b/Changes index ac0abd8..240ec62 100644 --- 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 --- 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 --- 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 --- 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 --- 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 + +This will return an hash of all the metaclass instances that have +been cached by B keyed by the package name. + +=item B + +This will return an array of all the metaclass instances that have +been cached by B. + +=item B + +This will return an array of all the metaclass names that have +been cached by B. + =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 ?@superclasses, + methods =E ?%methods, + attributes =E ?%attributes)> + +This will create an anonymous class, it works much like C 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 This initializes and returns returns a B object diff --git a/t/010_self_introspection.t b/t/010_self_introspection.t index 9f5d9f2..1bd53cf 100644 --- 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 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'); +