package # hide the package from PAUSE
- ArrayBasedStorage::Attribute;
-
-use strict;
-use warnings;
-
-use Carp 'confess';
-
-our $VERSION = '0.01';
-
-use base 'Class::MOP::Attribute';
-
-sub generate_accessor_method {
- my $self = shift;
- my $attr_name = $self->name;
- return sub {
- my $meta_instance = $_[0]->meta->get_meta_instance;
- $meta_instance->set_slot_value($_[0], $attr_name, $_[1]) if scalar(@_) == 2;
- $meta_instance->get_slot_value($_[0], $attr_name);
- };
-}
-
-sub generate_reader_method {
- my $self = shift;
- my $attr_name = $self->name;
- return sub {
- confess "Cannot assign a value to a read-only accessor" if @_ > 1;
- $_[0]->meta
- ->get_meta_instance
- ->get_slot_value($_[0], $attr_name);
- };
-}
-
-sub generate_writer_method {
- my $self = shift;
- my $attr_name = $self->name;
- return sub {
- $_[0]->meta
- ->get_meta_instance
- ->set_slot_value($_[0], $attr_name, $_[1]);
- };
-}
-
-sub generate_predicate_method {
- my $self = shift;
- my $attr_name = $self->name;
- return sub {
- defined $_[0]->meta
- ->get_meta_instance
- ->get_slot_value($_[0], $attr_name) ? 1 : 0;
- };
-}
-
-package # hide the package from PAUSE
ArrayBasedStorage::Instance;
use strict;
package Foo;
use metaclass 'Class::MOP::Class' => (
- ':attribute_metaclass' => 'ArrayBasedStorage::Attribute'
':instance_metaclass' => 'ArrayBasedStorage::Instance'
);
package # hide the package from PAUSE
- InsideOutClass::Attribute;
-
-use strict;
-use warnings;
-
-use Carp 'confess';
-
-our $VERSION = '0.01';
-
-use base 'Class::MOP::Attribute';
-
-sub generate_accessor_method {
- my $self = shift;
- my $attr_name = $self->name;
- return sub {
- my $meta_instance = $_[0]->meta->get_meta_instance;
- $meta_instance->set_slot_value($_[0], $attr_name, $_[1]) if scalar(@_) == 2;
- $meta_instance->get_slot_value($_[0], $attr_name);
- };
-}
-
-sub generate_reader_method {
- my $self = shift;
- my $attr_name = $self->name;
- return sub {
- confess "Cannot assign a value to a read-only accessor" if @_ > 1;
- $_[0]->meta
- ->get_meta_instance
- ->get_slot_value($_[0], $attr_name);
- };
-}
-
-sub generate_writer_method {
- my $self = shift;
- my $attr_name = $self->name;
- return sub {
- $_[0]->meta
- ->get_meta_instance
- ->set_slot_value($_[0], $attr_name, $_[1]);
- };
-}
-
-sub generate_predicate_method {
- my $self = shift;
- my $attr_name = $self->name;
- return sub {
- defined $_[0]->meta
- ->get_meta_instance
- ->get_slot_value($_[0], $attr_name) ? 1 : 0;
- };
-}
-
-package # hide the package from PAUSE
InsideOutClass::Instance;
use strict;
use warnings;
-our $VERSION = '0.06';
+our $VERSION = '0.01';
use Carp 'confess';
use Scalar::Util 'refaddr';
package Foo;
use metaclass 'Class::MOP::Class' => (
- # tell our metaclass to use the
- # InsideOut attribute metclass
- # to construct all it's attributes
':instance_metaclass' => 'InsideOutClass::Instance'
);
Class::MOP::Class->meta->add_attribute(
Class::MOP::Attribute->new('$:package' => (
- reader => 'name',
+ reader => {
+ # NOTE: we need to do this in order
+ # for the instance meta-object to
+ # not fall into meta-circular death
+ 'name' => sub { (shift)->{'$:package'} }
+ },
init_arg => ':package',
))
);
Class::MOP::Class->meta->add_attribute(
Class::MOP::Attribute->new('$:instance_metaclass' => (
- reader => 'instance_metaclass',
+ reader => {
+ # NOTE: we need to do this in order
+ # for the instance meta-object to
+ # not fall into meta-circular death
+ 'instance_metaclass' => sub { (shift)->{'$:instance_metaclass'} }
+ },
init_arg => ':instance_metaclass',
default => 'Class::MOP::Instance',
))
Class::MOP::Attribute->meta->add_attribute(
Class::MOP::Attribute->new('name' => (
- reader => 'name'
+ reader => {
+ # NOTE: we need to do this in order
+ # for the instance meta-object to
+ # not fall into meta-circular death
+ 'name' => sub { (shift)->{name} }
+ }
))
);
Class::MOP::Attribute->meta->add_attribute(
Class::MOP::Attribute->new('associated_class' => (
- reader => 'associated_class'
+ reader => {
+ # NOTE: we need to do this in order
+ # for the instance meta-object to
+ # not fall into meta-circular death
+ 'associated_class' => sub { (shift)->{associated_class} }
+ }
))
);
sub generate_accessor_method {
my $self = shift;
- my $meta_instance = $self->associated_class->get_meta_instance;
- my $attr_name = $self->name;
+ my $meta_class = $self->associated_class;
+ my $attr_name = $self->name;
return sub {
+ my $meta_instance = $meta_class->initialize(Scalar::Util::blessed($_[0]))->get_meta_instance;
$meta_instance->set_slot_value($_[0], $attr_name, $_[1]) if scalar(@_) == 2;
$meta_instance->get_slot_value($_[0], $attr_name);
};
sub generate_reader_method {
my $self = shift;
- my $meta_instance = $self->associated_class->get_meta_instance;
- my $attr_name = $self->name;
+ my $meta_class = $self->associated_class;
+ my $attr_name = $self->name;
return sub {
confess "Cannot assign a value to a read-only accessor" if @_ > 1;
- $meta_instance->get_slot_value($_[0], $attr_name);
+ $meta_class->initialize(Scalar::Util::blessed($_[0]))
+ ->get_meta_instance
+ ->get_slot_value($_[0], $attr_name);
};
}
sub generate_writer_method {
my $self = shift;
- my $meta_instance = $self->associated_class->get_meta_instance;
- my $attr_name = $self->name;
+ my $meta_class = $self->associated_class;
+ my $attr_name = $self->name;
return sub {
- $meta_instance->set_slot_value($_[0], $attr_name, $_[1]);
+ $meta_class->initialize(Scalar::Util::blessed($_[0]))
+ ->get_meta_instance
+ ->set_slot_value($_[0], $attr_name, $_[1]);
};
}
sub generate_predicate_method {
my $self = shift;
- my $meta_instance = $self->associated_class->get_meta_instance;
- my $attr_name = $self->name;
+ my $meta_class = $self->associated_class;
+ my $attr_name = $self->name;
return sub {
- defined $meta_instance->get_slot_value($_[0], $attr_name) ? 1 : 0;
+ defined $meta_class->initialize(Scalar::Util::blessed($_[0]))
+ ->get_meta_instance
+ ->get_slot_value($_[0], $attr_name) ? 1 : 0;
};
}
## check the attributes themselves
ok($meta->get_attribute('$:package')->has_reader, '... Class::MOP::Class $:package has a reader');
-is($meta->get_attribute('$:package')->reader, 'name', '... Class::MOP::Class $:package\'s a reader is &name');
+is(ref($meta->get_attribute('$:package')->reader), 'HASH', '... Class::MOP::Class $:package\'s a reader is { name => sub { ... } }');
ok($meta->get_attribute('$:package')->has_init_arg, '... Class::MOP::Class $:package has a init_arg');
is($meta->get_attribute('$:package')->init_arg, ':package', '... Class::MOP::Class $:package\'s a init_arg is :package');
use warnings;
use metaclass 'Class::MOP::Class' => (
- ':attribute_metaclass' => 'InsideOutClass::Attribute',
':instance_metaclass' => 'InsideOutClass::Instance'
);
use strict;
use warnings;
- use metaclass 'Class::MOP::Class' => (
- ':attribute_metaclass' => 'InsideOutClass::Attribute',
+ use metaclass 'Class::MOP::Class' => (
':instance_metaclass' => 'InsideOutClass::Instance'
);
use strict;
use warnings;
use metaclass 'Class::MOP::Class' => (
- ':attribute_metaclass' => 'ArrayBasedStorage::Attribute',
':instance_metaclass' => 'ArrayBasedStorage::Instance',
);
use strict;
use warnings;
use metaclass 'Class::MOP::Class' => (
- ':attribute_metaclass' => 'ArrayBasedStorage::Attribute',
':instance_metaclass' => 'ArrayBasedStorage::Instance',
);