adding in the metaclass pragma
Stevan Little [Sat, 4 Feb 2006 16:56:30 +0000 (16:56 +0000)]
Changes
examples/ClassEncapsulatedAttributes.pod
examples/InsideOutClass.pod
examples/InstanceCountingClass.pod
examples/LazyClass.pod
lib/metaclass.pm [new file with mode: 0644]
t/101_InstanceCountingClass_test.t
t/102_InsideOutClass_test.t
t/105_ClassEncapsulatedAttributes_test.t
t/106_LazyClass_test.t

diff --git a/Changes b/Changes
index 07c3f64..bae52de 100644 (file)
--- a/Changes
+++ b/Changes
@@ -1,6 +1,10 @@
 Revision history for Perl extension Class-MOP.
 
 0.06 
+    * metaclass
+      - adding new metaclass pragma to make assiging the 
+        metaclass a little more straightforward
+
     * Class::MOP::Class
       - fixing minor meta-circularity issue with &meta, it 
         is now more useful for subclasses
@@ -8,6 +12,7 @@ Revision history for Perl extension Class-MOP.
     * examples/
       - adjusting code to use the &Class::MOP::Class::meta
         fix detailed above
+      - adjusting code to use the metaclass pragma
       
 0.05 Sat Feb. 4, 2006
     * Class::MOP::Class
index 05bd099..9b6d9bf 100644 (file)
@@ -102,7 +102,7 @@ ClassEncapsulatedAttributes - A set of example metaclasses with class encapsulat
 
   package Foo;
   
-  sub meta { ClassEncapsulatedAttributes->initialize($_[0]) }
+  use metaclass 'ClassEncapsulatedAttributes';
   
   Foo->meta->add_attribute('foo' => (
       accessor  => 'Foo_foo',
index f0da289..781370e 100644 (file)
@@ -90,14 +90,12 @@ InsideOutClass - A set of example metaclasses which implement the Inside-Out tec
 
   package Foo;
   
-  sub meta { 
-      InsideOutClass->initialize($_[0] => (
-         # tell our metaclass to use the 
-         # InsideOut attribute metclass 
-         # to construct all it's attributes
-        ':attribute_metaclass' => 'InsideOutClass::Attribute'
-      )) 
-  }
+  use metaclass 'InsideOutClass' => (
+     # tell our metaclass to use the 
+     # InsideOut attribute metclass 
+     # to construct all it's attributes
+    ':attribute_metaclass' => 'InsideOutClass::Attribute'
+  );
   
   __PACKAGE__->meta->add_attribute('foo' => (
       reader => 'get_foo',
index c3057cf..92ae097 100644 (file)
@@ -36,7 +36,8 @@ InstanceCountingClass - An example metaclass which counts instances
 
   package Foo;
   
-  sub meta { InstanceCountingClass->initialize($_[0]) }
+  use metaclass 'InstanceCountingClass';
+  
   sub new  {
       my $class = shift;
       bless $class->meta->construct_instance(@_) => $class;
index 1f504af..8aaa30c 100644 (file)
@@ -77,11 +77,9 @@ LazyClass - An example metaclass with lazy initialization
 
   package BinaryTree;
   
-  sub meta {
-      LazyClass->initialize($_[0] => (
-          ':attribute_metaclass' => 'LazyClass::Attribute'
-      ));
-  }
+  use metaclass 'LazyClass' => (
+      ':attribute_metaclass' => 'LazyClass::Attribute'
+  );
   
   BinaryTree->meta->add_attribute('$:node' => (
       accessor => 'node',
diff --git a/lib/metaclass.pm b/lib/metaclass.pm
new file mode 100644 (file)
index 0000000..f9f0b75
--- /dev/null
@@ -0,0 +1,68 @@
+
+package metaclass;
+
+use strict;
+use warnings;
+
+use Carp 'confess';
+
+our $VERSION = '0.01';
+
+use Class::MOP;
+
+sub import {
+    shift;
+    my $metaclass = shift;
+    my %options   = @_;
+    my $package   = caller();
+    
+    ($metaclass->isa('Class::MOP::Class'))
+        || confess 'The metaclass must be derived from Class::MOP::Class';
+    
+    # create a meta object so we can install &meta
+    my $meta = $metaclass->initialize($package => %options);
+    $meta->add_method('meta' => sub {
+        # we must re-initialize so that it 
+        # works as expected in subclasses, 
+        # since metaclass instances are 
+        # singletons, this is not really a 
+        # big deal anyway.
+        $metaclass->initialize($_[0] => %options)
+    });
+}
+
+1;
+
+__END__
+
+=pod
+
+=head1 NAME
+
+metaclass - a pragma for installing using Class::MOP metaclasses
+
+=head1 SYNOPSIS
+
+  use metaclass 'MyMetaClass';
+  
+  use metaclass 'MyMetaClass' => (
+      ':attribute_metaclass' => 'MyAttributeMetaClass',
+      ':method_metaclass'    => 'MyMethodMetaClass',    
+  );
+
+=head1 DESCRIPTION
+
+=head1 AUTHOR
+
+Stevan Little E<lt>stevan@iinteractive.comE<gt>
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright 2006 by Infinity Interactive, Inc.
+
+L<http://www.iinteractive.com>
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself. 
+
+=cut
\ No newline at end of file
index 829ab28..9941c7d 100644 (file)
@@ -23,7 +23,8 @@ a simple demonstration of how to make a metaclass.
 {
     package Foo;
     
-    sub meta { InstanceCountingClass->initialize($_[0]) }
+    use metaclass 'InstanceCountingClass';
+    
     sub new  {
         my $class = shift;
         bless $class->meta->construct_instance(@_) => $class;
index 7aae76c..5341b19 100644 (file)
@@ -14,11 +14,9 @@ BEGIN {
 {
     package Foo;
     
-    sub meta { 
-        InsideOutClass->initialize($_[0] => (
-          ':attribute_metaclass' => 'InsideOutClass::Attribute'
-        )) 
-    }
+    use metaclass 'InsideOutClass' => (
+        ':attribute_metaclass' => 'InsideOutClass::Attribute'
+    );
     
     Foo->meta->add_attribute('foo' => (
         accessor  => 'foo',
index 47952e6..712d35a 100644 (file)
@@ -14,7 +14,7 @@ BEGIN {
 {
     package Foo;
     
-    sub meta { ClassEncapsulatedAttributes->initialize($_[0]) }
+    use metaclass 'ClassEncapsulatedAttributes';
     
     Foo->meta->add_attribute('foo' => (
         accessor  => 'foo',
index 8accf69..6a75aac 100644 (file)
@@ -14,11 +14,9 @@ BEGIN {
 {
     package BinaryTree;
     
-    sub meta {
-        LazyClass->initialize($_[0] => (
-            ':attribute_metaclass' => 'LazyClass::Attribute'
-        ));
-    }
+    use metaclass 'LazyClass' => (
+        ':attribute_metaclass' => 'LazyClass::Attribute'
+    );
 
     BinaryTree->meta->add_attribute('$:node' => (
         accessor => 'node',