'Sub::Name' => '0.02',
'Carp' => '0.01',
'B' => '1.09',
- 'B::Deparse' => '0.70',
'Clone' => '0.18',
'SUPER' => '1.11',
},
0.07
- adding more tests
+ - test for compatability with Class::C3
- added SUPER as a dependency (because we need runtime
- dispatching of SUPER calls for traits)
+ dispatching of SUPER calls for mixins)
+
+ * Class::MOP
+ - no longer optionally exports to UNIVERSAL::meta or
+ creates a custom metaclass generator, use the
+ metaclass pragma instead.
+
+ * Class::MOP::Class
+ - adding in &mixin method to do Scala style mixins
0.06 Thurs Feb. 9, 2006
* metaclass
package Foo;
- use Class::MOP 'meta';
-
Foo->meta->add_attribute(AttributesWithHistory->new('foo' => (
accessor => 'foo',
history_accessor => 'get_foo_history',
foreach my $current_class ($class->class_precedence_list()) {
$instance->{$current_class} = {}
unless exists $instance->{$current_class};
- my $meta = $class->initialize($current_class);
+ my $meta = $current_class->meta;
foreach my $attr_name ($meta->get_attribute_list()) {
my $attr = $meta->get_attribute($attr_name);
# if the attr has an init_arg, use that, otherwise,
package Foo;
- use Class::MOP 'meta';
-
Foo->meta->add_attribute(Perl6Attribute->new('$.foo'));
Foo->meta->add_attribute(Perl6Attribute->new('@.bar'));
Foo->meta->add_attribute(Perl6Attribute->new('%.baz'));
use strict;
use warnings;
-use Scalar::Util 'blessed';
use Carp 'confess';
-use SUPER ();
+use Scalar::Util ();
use Class::MOP::Class;
use Class::MOP::Attribute;
our $VERSION = '0.07';
-sub import {
- shift;
- return unless @_;
- if ($_[0] eq ':universal') {
- *UNIVERSAL::meta = sub {
- Class::MOP::Class->initialize(blessed($_[0]) || $_[0])
- };
- }
- else {
- my $pkg = caller();
- no strict 'refs';
- *{$pkg . '::' . $_[0]} = sub {
- Class::MOP::Class->initialize(blessed($_[0]) || $_[0])
- };
- }
-}
+## ----------------------------------------------------------------------------
+## Setting up our environment ...
+## ----------------------------------------------------------------------------
+## Class::MOP needs to have a few things in the global perl environment so
+## that it can operate effectively. Those things are done here.
+## ----------------------------------------------------------------------------
+
+# so that mixins can have runtime
+# dispatched SUPER calls
+use SUPER ();
## ----------------------------------------------------------------------------
## Bootstrapping
I<Uniform and safe metaclass composition> linked to in the
L<SEE ALSO> section of this document.
+=head2 Using custom metaclasses
+
+Always use the metaclass pragma when using a custom metaclass, this
+will ensure the proper initialization order and not accidentely
+create an incorrect type of metaclass for you. This is a very rare
+problem, and one which can only occur if you are doing deep metaclass
+programming. So in other words, don't worry about it.
+
=head1 PROTOCOLS
The protocol is divided into 3 main sub-protocols:
use Carp 'confess';
use Scalar::Util 'blessed', 'reftype', 'weaken';
-our $VERSION = '0.03';
+our $VERSION = '0.04';
sub meta {
require Class::MOP::Class;
- Class::MOP::Class->initialize($_[0])
+ Class::MOP::Class->initialize(blessed($_[0]) || $_[0]);
}
# NOTE: (meta-circularity)
our $VERSION = '0.03';
-# Self-introspection
+# Self-introspection
-sub meta { Class::MOP::Class->initialize($_[0]) }
+sub meta { Class::MOP::Class->initialize(blessed($_[0]) || $_[0]) }
# Creation
eval $code;
confess "creation of $package_name failed : $@" if $@;
my $meta = $class->initialize($package_name);
+
+ $meta->add_method('meta' => sub {
+ Class::MOP::Class->initialize(blessed($_[0]) || $_[0]);
+ });
+
$meta->superclasses(@{$options{superclasses}})
if exists $options{superclasses};
# NOTE:
next if $seen_class{$class};
$seen_class{$class}++;
# fetch the meta-class ...
- my $meta = $self->initialize($class);
+ my $meta = $self->initialize($class);;
push @methods => {
name => $method_name,
class => $class,
sub mixin {
my ($self, $mixin) = @_;
- $mixin = $self->initialize($mixin) unless blessed($mixin);
+ $mixin = $self->initialize($mixin)
+ unless blessed($mixin);
- my @attributes = map { $mixin->get_attribute($_)->clone() }
- $mixin->get_attribute_list;
- my %methods = map {
- my $method = $mixin->get_method($_);
- if (blessed($method) && $method->isa('Class::MOP::Attribute::Accessor')) {
- ();
- }
- else {
- ($_ => $method)
- }
- } $mixin->get_method_list;
-
- # test the superclass thing detailed in the test
+ my @attributes = map {
+ $mixin->get_attribute($_)->clone()
+ } $mixin->get_attribute_list;
+ my %methods = map {
+ my $method = $mixin->get_method($_);
+ (blessed($method) && $method->isa('Class::MOP::Attribute::Accessor'))
+ ? () : ($_ => $method)
+ } $mixin->get_method_list;
+
foreach my $attr (@attributes) {
$self->add_attribute($attr)
unless $self->has_attribute($attr->name);
# use this for introspection ...
- package Foo;
- sub meta { Class::MOP::Class->initialize(__PACKAGE__) }
-
- # elsewhere in the code ...
-
# add a method to Foo ...
Foo->meta->add_method('bar' => sub { ... })
use warnings;
use Carp 'confess';
-use Scalar::Util 'reftype';
+use Scalar::Util 'reftype', 'blessed';
our $VERSION = '0.01';
sub meta {
require Class::MOP::Class;
- Class::MOP::Class->initialize($_[0])
+ Class::MOP::Class->initialize(blessed($_[0]) || $_[0]);
}
sub wrap {
{
package Foo;
+ use metaclass;
our $VERSION = '0.01';
package Bar;
our @ISA = ('Foo');
}
-my $Foo = Class::MOP::Class->initialize('Foo');
+my $Foo = Foo->meta;
isa_ok($Foo, 'Class::MOP::Class');
-my $Bar = Class::MOP::Class->initialize('Bar');
+my $Bar = Bar->meta;
isa_ok($Bar, 'Class::MOP::Class');
is($Foo->name, 'Foo', '... Foo->name == Foo');
superclasses => [ 'Bar' ]
));
isa_ok($Baz, 'Class::MOP::Class');
-is(Class::MOP::Class->initialize('Baz'), $Baz, '... our metaclasses are singletons');
+is(Baz->meta, $Baz, '... our metaclasses are singletons');
is($Baz->name, 'Baz', '... Baz->name == Baz');
is($Baz->version, '0.10', '... Baz->version == 0.10');
{
package My::A;
+ use metaclass;
package My::B;
our @ISA = ('My::A');
package My::C;
}
is_deeply(
- [ Class::MOP::Class->initialize('My::D')->class_precedence_list ],
+ [ My::D->meta->class_precedence_list ],
[ 'My::D', 'My::B', 'My::A', 'My::C', 'My::A' ],
'... My::D->meta->class_precedence_list == (D B A C A)');
{
package My::2::A;
+ use metaclass;
our @ISA = ('My::2::C');
package My::2::B;
our @ISA = ('My::2::B');
}
-eval { Class::MOP::Class->initialize('My::2::B')->class_precedence_list };
+eval { My::2::B->meta->class_precedence_list };
ok($@, '... recursive inheritance breaks correctly :)');
=pod
{
package My::3::A;
+ use metaclass;
package My::3::B;
our @ISA = ('My::3::A');
package My::3::C;
}
is_deeply(
- [ Class::MOP::Class->initialize('My::3::D')->class_precedence_list ],
+ [ My::3::D->meta->class_precedence_list ],
[ 'My::3::D', 'My::3::B', 'My::3::A', 'My::3::C', 'My::3::A', 'My::3::B', 'My::3::A' ],
'... My::3::D->meta->class_precedence_list == (D B A C A B A)');
{
package Foo;
+ use metaclass;
sub CPL { push @CLASS_PRECEDENCE_LIST => 'Foo' }
}
package Baz;
+ use metaclass;
our @ISA = ('Bar');
sub CPL {
Foo::Bar::Baz->CPL();
is_deeply(
- [ Class::MOP::Class->initialize('Foo::Bar::Baz')->class_precedence_list ],
+ [ Foo::Bar::Baz->meta->class_precedence_list ],
[ @CLASS_PRECEDENCE_LIST ],
'... Foo::Bar::Baz->meta->class_precedence_list == @CLASS_PRECEDENCE_LIST');
is_deeply(
[ sort $Bar->get_method_list ],
- [ qw(bar foo) ],
+ [ qw(bar foo meta) ],
'... got the right method list for Bar');
is_deeply(
class => 'Bar',
code => $Bar->get_method('foo')
},
+ {
+ name => 'meta',
+ class => 'Bar',
+ code => $Bar->get_method('meta')
+ }
],
'... got the right list of applicable methods for Bar');
use Test::Exception;
BEGIN {
- use_ok('Class::MOP', ':universal');
+ use_ok('Class::MOP');
}
my $FOO_ATTR = Class::MOP::Attribute->new('$foo');
{
package Foo;
+ use metaclass;
my $meta = Foo->meta;
::lives_ok {
use strict;
use warnings;
-use Test::More tests => 115;
+use Test::More tests => 119;
use Test::Exception;
BEGIN {
superclasses class_precedence_list
- has_method get_method add_method remove_method
+ has_method get_method add_method remove_method alias_method
get_method_list compute_all_applicable_methods find_all_methods_by_name
has_attribute get_attribute add_attribute remove_attribute
get_attribute_list get_attribute_map compute_all_applicable_attributes
add_package_variable get_package_variable has_package_variable remove_package_variable
+
+ mixin
);
is_deeply([ sort @methods ], [ sort $meta->get_method_list ], '... got the correct method list');
use Test::Exception;
BEGIN {
- use_ok('Class::MOP', ':universal');
+ use_ok('Class::MOP');
}
my $Point = Class::MOP::Class->create('Point' => '0.01' => (
use Test::Exception;
BEGIN {
- use_ok('Class::MOP', ':universal');
+ use_ok('Class::MOP');
}
{
package Foo;
+ use metaclass;
}
ok(!defined($Foo::{foo}), '... the %foo slot has not been created yet');
use Test::Exception;
BEGIN {
- use_ok('Class::MOP', ':universal');
+ use_ok('Class::MOP');
}
{
package Point;
+ use metaclass;
Point->meta->add_attribute('$.x' => (
reader => 'x',
isa_ok($meta, 'Class::MOP::Class');
my @methods = qw(
- meta
+ meta
new clone
name
has_accessor accessor
use strict;
use warnings;
-use Test::More tests => 9;
+use Test::More tests => 8;
use Test::Exception;
BEGIN {
isa_ok($meta, 'Class::MOP::Class');
foreach my $method_name (qw(
- meta
wrap
)) {
ok($meta->has_method($method_name), '... Class::MOP::Method->has_method(' . $method_name . ')');
use strict;
use warnings;
-use Test::More no_plan => 4;
+use Test::More tests => 4;
=pod
}
class ColoredPoint2D(u: Int, v: Int, c: String) extends Point2D(u, v) {
- var color = c;
+ val color = c;
def setColor(newCol: String): Unit = color = newCol;
override def toString() = super.toString() + ", col = " + color;
}
is($colored_point_3d->toString(),
'x = 1, y = 2, z = 3, col = blue',
'... got the right toString method');
+
+
{
package Foo;
-
- use Class::MOP 'meta';
+ use metaclass;
Foo->meta->add_attribute(AttributesWithHistory->new('foo' => (
accessor => 'foo',
projects / gitmo/Class-MOP.git / commitdiff