Class::MOP::Class->initialize(blessed($_[0]) || $_[0])
};
}
+ else {
+ my $pkg = caller();
+ no strict 'refs';
+ *{$pkg . '::' . $_[0]} = sub {
+ Class::MOP::Class->initialize(blessed($_[0]) || $_[0])
+ };
+ }
}
## ----------------------------------------------------------------------------
bless $class->meta->construct_instance(name => $name, %options) => $class;
});
-# NOTE: (meta-circularity)
-# This is how we "tie the knot" for the class
-# meta-objects. This is used to construct the
-# Class::MOP::Class instances after all the
-# bootstrapping is complete.
-Class::MOP::Class->meta->add_method('construct_class_instance' => sub {
- my ($class, $package_name) = @_;
- (defined $package_name && $package_name)
- || confess "You must pass a package name";
- bless Class::MOP::Class->meta->construct_instance(':pkg' => $package_name) => blessed($class) || $class
-});
-
1;
__END__
# NOTE: (meta-circularity)
# this is a special form of &construct_instance
# (see below), which is used to construct class
- # meta-object instances. It will be replaces in
- # the bootstrap section in Class::MOP with one
- # which uses the normal &construct_instance.
+ # meta-object instances for any Class::MOP::*
+ # class. All other classes will use the more
+ # normal &construct_instance.
sub construct_class_instance {
my ($class, $package_name) = @_;
(defined $package_name && $package_name)
- || confess "You must pass a package name";
- bless {
- '$:pkg' => $package_name,
- '%:attrs' => {}
- } => blessed($class) || $class
+ || confess "You must pass a package name";
+ $class = blessed($class) || $class;
+ if ($class =~ /^Class::MOP::/) {
+ bless {
+ '$:pkg' => $package_name,
+ '%:attrs' => {}
+ } => $class;
+ }
+ else {
+ bless $class->meta->construct_instance(':pkg' => $package_name) => $class
+ }
}
}
use strict;
use warnings;
-use Test::More no_plan => 1;
+use Test::More tests => 4;
BEGIN {
- use_ok('Class::MOP' => '-> this-is-ignored :)');
+ use_ok('Class::MOP');
use_ok('Class::MOP::Class');
use_ok('Class::MOP::Attribute');
use_ok('Class::MOP::Method');
use strict;
use warnings;
-use Test::More no_plan => 1;
+use Test::More tests => 19;
use Test::Exception;
BEGIN {
use strict;
use warnings;
-use Test::More no_plan => 1;
+use Test::More tests => 6;
BEGIN {
use_ok('Class::MOP');
use strict;
use warnings;
-use Test::More no_plan => 1;
+use Test::More tests => 38;
use Test::Exception;
BEGIN {
use strict;
use warnings;
-use Test::More no_plan => 1;
+use Test::More tests => 9;
use Test::Exception;
BEGIN {
use strict;
use warnings;
-use Test::More no_plan => 1;
+use Test::More tests => 30;
use Test::Exception;
BEGIN {
use strict;
use warnings;
-use Test::More no_plan => 1;
+use Test::More tests => 56;
use Test::Exception;
BEGIN {
use strict;
use warnings;
-use Test::More no_plan => 1;
+use Test::More tests => 27;
use Test::Exception;
BEGIN {
use strict;
use warnings;
-use Test::More no_plan => 1;
+use Test::More tests => 64;
use Test::Exception;
BEGIN {
use strict;
use warnings;
-use Test::More no_plan => 1;
+use Test::More tests => 9;
use Test::Exception;
BEGIN {
--- /dev/null
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 12;
+
+BEGIN {
+ use_ok('Class::MOP');
+ use_ok('t::lib::CountingClass');
+}
+
+=pod
+
+This is a trivial and contrived example of how to
+make a metaclass which will count all the instances
+created. It is not meant to be anything more than
+a simple demonstration of how to make a metaclass.
+
+=cut
+
+{
+ package Foo;
+
+ sub meta { CountingClass->initialize($_[0]) }
+ sub new {
+ my $class = shift;
+ bless $class->meta->construct_instance() => $class;
+ }
+
+ package Bar;
+
+ our @ISA = ('Foo');
+}
+
+is(Foo->meta->get_count(), 0, '... our Foo count is 0');
+is(Bar->meta->get_count(), 0, '... our Bar count is 0');
+
+my $foo = Foo->new();
+isa_ok($foo, 'Foo');
+
+is(Foo->meta->get_count(), 1, '... our Foo count is now 1');
+is(Bar->meta->get_count(), 0, '... our Bar count is still 0');
+
+my $bar = Bar->new();
+isa_ok($bar, 'Bar');
+
+is(Foo->meta->get_count(), 1, '... our Foo count is still 1');
+is(Bar->meta->get_count(), 1, '... our Bar count is now 1');
+
+for (2 .. 10) {
+ Foo->new();
+}
+
+is(Foo->meta->get_count(), 10, '... our Foo count is now 10');
+is(Bar->meta->get_count(), 1, '... our Bar count is still 1');
+
-use Class::MOP ':universal';
-
package BinaryTree;
use strict;
use warnings;
+use Class::MOP 'meta';
+
our $VERSION = '0.01';
__PACKAGE__->meta->add_attribute(
--- /dev/null
+
+package CountingClass;
+
+use strict;
+use warnings;
+
+use Class::MOP 'meta';
+
+our $VERSION = '0.01';
+
+__PACKAGE__->meta->superclasses('Class::MOP::Class');
+
+__PACKAGE__->meta->add_attribute(
+ Class::MOP::Attribute->new('$:count' => (
+ reader => 'get_count',
+ default => 0
+ ))
+);
+
+sub construct_instance {
+ my ($class, %params) = @_;
+ $class->{'$:count'}++;
+ return $class->SUPER::construct_instance();
+}
+
+1;
\ No newline at end of file