From: Stevan Little Date: Sat, 4 Feb 2006 16:56:30 +0000 (+0000) Subject: adding in the metaclass pragma X-Git-Tag: 0_06~11 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=677eb1584b6e27c6079daed35110cb4192153db4;p=gitmo%2FClass-MOP.git adding in the metaclass pragma --- diff --git a/Changes b/Changes index 07c3f64..bae52de 100644 --- 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 diff --git a/examples/ClassEncapsulatedAttributes.pod b/examples/ClassEncapsulatedAttributes.pod index 05bd099..9b6d9bf 100644 --- a/examples/ClassEncapsulatedAttributes.pod +++ b/examples/ClassEncapsulatedAttributes.pod @@ -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', diff --git a/examples/InsideOutClass.pod b/examples/InsideOutClass.pod index f0da289..781370e 100644 --- a/examples/InsideOutClass.pod +++ b/examples/InsideOutClass.pod @@ -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', diff --git a/examples/InstanceCountingClass.pod b/examples/InstanceCountingClass.pod index c3057cf..92ae097 100644 --- a/examples/InstanceCountingClass.pod +++ b/examples/InstanceCountingClass.pod @@ -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; diff --git a/examples/LazyClass.pod b/examples/LazyClass.pod index 1f504af..8aaa30c 100644 --- a/examples/LazyClass.pod +++ b/examples/LazyClass.pod @@ -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 index 0000000..f9f0b75 --- /dev/null +++ b/lib/metaclass.pm @@ -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 Estevan@iinteractive.comE + +=head1 COPYRIGHT AND LICENSE + +Copyright 2006 by Infinity Interactive, Inc. + +L + +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 diff --git a/t/101_InstanceCountingClass_test.t b/t/101_InstanceCountingClass_test.t index 829ab28..9941c7d 100644 --- a/t/101_InstanceCountingClass_test.t +++ b/t/101_InstanceCountingClass_test.t @@ -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; diff --git a/t/102_InsideOutClass_test.t b/t/102_InsideOutClass_test.t index 7aae76c..5341b19 100644 --- a/t/102_InsideOutClass_test.t +++ b/t/102_InsideOutClass_test.t @@ -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', diff --git a/t/105_ClassEncapsulatedAttributes_test.t b/t/105_ClassEncapsulatedAttributes_test.t index 47952e6..712d35a 100644 --- a/t/105_ClassEncapsulatedAttributes_test.t +++ b/t/105_ClassEncapsulatedAttributes_test.t @@ -14,7 +14,7 @@ BEGIN { { package Foo; - sub meta { ClassEncapsulatedAttributes->initialize($_[0]) } + use metaclass 'ClassEncapsulatedAttributes'; Foo->meta->add_attribute('foo' => ( accessor => 'foo', diff --git a/t/106_LazyClass_test.t b/t/106_LazyClass_test.t index 8accf69..6a75aac 100644 --- a/t/106_LazyClass_test.t +++ b/t/106_LazyClass_test.t @@ -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',