my $meta = User->meta();
- for my $attribute ( $meta->compute_all_applicable_attributes ) {
+ for my $attribute ( $meta->get_all_attributes ) {
print $attribute->name(), "\n";
if ( $attribute->has_type_constraint ) {
}
}
- for my $method ( $meta->compute_all_applicable_methods ) {
+ for my $method ( $meta->get_all_methods ) {
print $method->name, "\n";
}
my ( @init, @non_init );
- foreach my $attr ( grep { $_->has_value($self) } Class::MOP::class_of($self)->compute_all_applicable_attributes ) {
+ foreach my $attr ( grep { $_->has_value($self) } Class::MOP::class_of($self)->get_all_attributes ) {
push @{ $attr->has_init_arg ? \@init : \@non_init }, $attr;
}
return $class;
}
-sub check_metaclass_compatibility {
+sub _check_metaclass_compatibility {
my $self = shift;
if ( my @supers = $self->superclasses ) {
$self->_fix_metaclass_incompatibility(@supers);
}
- $self->SUPER::check_metaclass_compatibility(@_);
+ $self->SUPER::_check_metaclass_compatibility(@_);
}
my %ANON_CLASSES;
my $params = @_ == 1 ? $_[0] : {@_};
my $self = $class->SUPER::new_object($params);
- foreach my $attr ( $class->compute_all_applicable_attributes() ) {
+ foreach my $attr ( $class->get_all_attributes() ) {
next unless $attr->can('has_trigger') && $attr->has_trigger;
return $self;
}
-sub construct_instance {
+sub _construct_instance {
my $class = shift;
my $params = @_ == 1 ? $_[0] : {@_};
my $meta_instance = $class->get_meta_instance;
# but this is foreign inheritance, so we might
# have to kludge it in the end.
my $instance = $params->{'__INSTANCE__'} || $meta_instance->create_instance();
- foreach my $attr ($class->compute_all_applicable_attributes()) {
+ foreach my $attr ($class->get_all_attributes()) {
$attr->initialize_instance_slot($meta_instance, $instance, $params);
}
return $instance;
or $self->throw_error("Could not create writer for '${\$self->associated_attribute->name}' because $@ \n code: $code", error => $@, data => $code );
}
-sub generate_accessor_method_inline {
+sub _generate_accessor_method_inline {
my $self = $_[0];
my $attr = $self->associated_attribute;
my $attr_name = $attr->name;
. ' }');
}
-sub generate_writer_method_inline {
+sub _generate_writer_method_inline {
my $self = $_[0];
my $attr = $self->associated_attribute;
my $attr_name = $attr->name;
. ' }');
}
-sub generate_reader_method_inline {
+sub _generate_reader_method_inline {
my $self = $_[0];
my $attr = $self->associated_attribute;
my $attr_name = $attr->name;
return $attr->should_coerce;
}
-sub generate_reader_method { shift->generate_reader_method_inline(@_) }
-sub generate_writer_method { shift->generate_writer_method_inline(@_) }
-sub generate_accessor_method { shift->generate_accessor_method_inline(@_) }
-sub generate_predicate_method { shift->generate_predicate_method_inline(@_) }
-sub generate_clearer_method { shift->generate_clearer_method_inline(@_) }
+sub _generate_reader_method { shift->_generate_reader_method_inline(@_) }
+sub _generate_writer_method { shift->_generate_writer_method_inline(@_) }
+sub _generate_accessor_method { shift->_generate_accessor_method_inline(@_) }
+sub _generate_predicate_method { shift->_generate_predicate_method_inline(@_) }
+sub _generate_clearer_method { shift->_generate_clearer_method_inline(@_) }
sub _inline_pre_body { '' }
sub _inline_post_body { '' }
|| $class->throw_error("You must supply the package_name and name parameters $Class::MOP::Method::UPGRADE_ERROR_TEXT");
my $self = bless {
- # from our superclass
'body' => undef,
'package_name' => $options{package_name},
'name' => $options{name},
- # specific to this subclass
'options' => $options{options},
- 'meta_instance' => $meta->get_meta_instance,
- 'attributes' => [ $meta->compute_all_applicable_attributes ],
- # ...
'associated_metaclass' => $meta,
} => $class;
# needed
weaken($self->{'associated_metaclass'});
- $self->initialize_body;
+ $self->_initialize_body;
return $self;
}
return 'Moose::Object';
}
-## accessors
-
-sub meta_instance { (shift)->{'meta_instance'} }
-sub attributes { (shift)->{'attributes'} }
-
## method
-sub initialize_body {
+sub _initialize_body {
my $self = shift;
# TODO:
# the %options should also include a both
# because the inlined code is using the index of the attributes
# to determine where to find the type constraint
- my $attrs = $self->attributes;
+ my $attrs = $self->_attributes;
my @type_constraints = map {
$_->can('type_constraint') ? $_->type_constraint : undef
sub _generate_instance {
my ( $self, $var, $class_var ) = @_;
"my $var = "
- . $self->meta_instance->inline_create_instance($class_var) . ";\n";
+ . $self->_meta_instance->inline_create_instance($class_var) . ";\n";
}
sub _generate_slot_initializers {
my ($self) = @_;
return (join ";\n" => map {
$self->_generate_slot_initializer($_)
- } 0 .. (@{$self->attributes} - 1)) . ";\n";
+ } 0 .. (@{$self->_attributes} - 1)) . ";\n";
}
sub _generate_BUILDARGS {
sub _generate_triggers {
my $self = shift;
my @trigger_calls;
- foreach my $i ( 0 .. $#{ $self->attributes } ) {
- my $attr = $self->attributes->[$i];
+ foreach my $i ( 0 .. $#{ $self->_attributes } ) {
+ my $attr = $self->_attributes->[$i];
next unless $attr->can('has_trigger') && $attr->has_trigger;
. $i
. ']->trigger->('
. '$instance, '
- . $self->meta_instance->inline_get_slot_value(
+ . $self->_meta_instance->inline_get_slot_value(
'$instance',
$attr->name,
)
my $self = shift;
my $index = shift;
- my $attr = $self->attributes->[$index];
+ my $attr = $self->_attributes->[$index];
my @source = ('## ' . $attr->name);
}
else {
$source = (
- $self->meta_instance->inline_set_slot_value(
+ $self->_meta_instance->inline_set_slot_value(
'$instance',
$attr->name,
$value
if ($is_moose && $attr->is_weak_ref) {
$source .= (
"\n" .
- $self->meta_instance->inline_weaken_slot_value(
+ $self->_meta_instance->inline_weaken_slot_value(
'$instance',
$attr->name
) .
|| confess "You must pass a HASH ref of methods"
if exists $options{methods};
- $role->SUPER::create(%options);
-
my (%initialize_options) = %options;
delete @initialize_options{qw(
package
my $meta = $role->initialize( $package_name => %initialize_options );
+ $meta->_instantiate_module( $options{version}, $options{authority} );
+
# FIXME totally lame
$meta->add_method('meta' => sub {
$role->initialize(ref($_[0]) || $_[0]);
return +{
map { $_->name => $_->get_value($instance) }
grep { $_->has_value($instance) }
- $class->compute_all_applicable_attributes
+ $class->get_all_attributes
};
}
map { $_->init_arg => $_->get_value($instance) }
grep { $_->has_value($instance) }
grep { defined($_->init_arg) }
- $class->compute_all_applicable_attributes
+ $class->get_all_attributes
};
}
{
- package Elk;
- use strict;
- use warnings;
-
- sub new {
- my $class = shift;
- bless { no_moose => "Elk" } => $class;
- }
-
- sub no_moose { $_[0]->{no_moose} }
-
- package Foo::Moose;
- use Moose;
-
- extends 'Elk';
-
- has 'moose' => (is => 'ro', default => 'Foo');
-
- sub new {
- my $class = shift;
- my $super = $class->SUPER::new(@_);
- return $class->meta->new_object('__INSTANCE__' => $super, @_);
- }
-
- __PACKAGE__->meta->make_immutable(debug => 0);
+
+ package Elk;
+ use strict;
+ use warnings;
+
+ sub new {
+ my $class = shift;
+ bless { no_moose => "Elk" } => $class;
+ }
+
+ sub no_moose { $_[0]->{no_moose} }
+
+ package Foo::Moose;
+ use Moose;
+
+ extends 'Elk';
+
+ has 'moose' => ( is => 'ro', default => 'Foo' );
+
+ sub new {
+ my $class = shift;
+ my $super = $class->SUPER::new(@_);
+ return $class->meta->new_object( '__INSTANCE__' => $super, @_ );
+ }
+
+ __PACKAGE__->meta->make_immutable( debug => 0 );
package Bucket;
use metaclass 'Class::MOP::Class';
-
- __PACKAGE__->meta->add_attribute('squeegee' => (accessor => 'squeegee'));
-
+
+ __PACKAGE__->meta->add_attribute(
+ 'squeegee' => ( accessor => 'squeegee' ) );
+
package Old::Bucket::Nose;
+
# see http://www.moosefoundation.org/moose_facts.htm
use Moose;
-
+
extends 'Bucket';
package MyBase;
use metaclass 'Custom::Meta2';
use Moose;
- # XXX FIXME subclassing meta-attrs and immutable-ing the subclass fails
+ # XXX FIXME subclassing meta-attrs and immutable-ing the subclass fails
}
my $foo_moose = Foo::Moose->new();
-isa_ok($foo_moose, 'Foo::Moose');
-isa_ok($foo_moose, 'Elk');
+isa_ok( $foo_moose, 'Foo::Moose' );
+isa_ok( $foo_moose, 'Elk' );
-is($foo_moose->no_moose, 'Elk', '... got the right value from the Elk method');
-is($foo_moose->moose, 'Foo', '... got the right value from the Foo::Moose method');
+is( $foo_moose->no_moose, 'Elk',
+ '... got the right value from the Elk method' );
+is( $foo_moose->moose, 'Foo',
+ '... got the right value from the Foo::Moose method' );
+
+lives_ok {
+ Old::Bucket::Nose->meta->make_immutable( debug => 0 );
+}
+'Immutability on Moose class extending Class::MOP class ok';
-lives_ok {
- Old::Bucket::Nose->meta->make_immutable(debug => 0);
-} 'Immutability on Moose class extending Class::MOP class ok';
-
lives_ok {
SubClass2->meta->superclasses('MyBase');
-} 'Can subclass the same non-Moose class twice with different metaclasses';
+}
+'Can subclass the same non-Moose class twice with different metaclasses';
$db->{$class}->[($oid - 1)] = {};
- $self->bless_instance_structure({
+ bless {
oid => $oid,
instance => $db->{$class}->[($oid - 1)]
- });
+ }, $class;
}
sub find_instance {
my ($self, $oid) = @_;
my $instance = $db->{$self->associated_metaclass->name}->[($oid - 1)];
- $self->bless_instance_structure({
+
+ bless {
oid => $oid,
- instance => $instance
- });
+ instance => $instance,
+ }, $self->associated_metaclass->name;
}
sub clone_instance {
my $clone = tied($instance)->clone;
- $self->bless_instance_structure({
+ bless {
oid => $oid,
- instance => $clone
- });
+ instance => $clone,
+ }, $class;
}
}
extends 'Moose::Meta::Class';
- override 'construct_instance' => sub {
+ override '_construct_instance' => sub {
my $class = shift;
my $params = @_ == 1 ? $_[0] : {@_};
return $class->get_meta_instance->find_instance($params->{oid})
return $instance;
}
- sub generate_accessor_method {
+ sub _generate_accessor_method {
my $self = shift;
my $attr = $self->associated_attribute;
return sub {
};
}
- sub generate_reader_method {
+ sub _generate_reader_method {
my $self = shift;
my $attr = $self->associated_attribute;
return sub {
};
}
- sub generate_writer_method {
+ sub _generate_writer_method {
my $self = shift;
my $attr = $self->associated_attribute;
return sub {
projects / gitmo/Moose.git / commitdiff