use Mouse::Meta::Method::Constructor;
use Mouse::Meta::Method::Destructor;
-use Scalar::Util qw/blessed/;
+use Scalar::Util qw/blessed weaken/;
use Mouse::Util qw/get_linear_isa version authority identifier/;
use Carp 'confess';
}
sub initialize {
- my $class = blessed($_[0]) || $_[0];
- my $name = $_[1];
+ my($class, $package_name, @args) = @_;
- $METACLASS_CACHE{$name} = $class->new(name => $name)
- if !exists($METACLASS_CACHE{$name});
- return $METACLASS_CACHE{$name};
+ ($package_name && !ref($package_name))\r
+ || confess("You must pass a package name and it cannot be blessed");\r
+
+ return $METACLASS_CACHE{$package_name}
+ ||= $class->_construct_class_instance(package => $package_name, @args);
}
+
+ # Means of accessing all the metaclasses that have
+ # been initialized thus far
+ sub get_all_metaclasses { %METACLASS_CACHE }
+ sub get_all_metaclass_instances { values %METACLASS_CACHE }
+ sub get_all_metaclass_names { keys %METACLASS_CACHE }
+ sub get_metaclass_by_name { $METACLASS_CACHE{$_[0]} }
+ sub store_metaclass_by_name { $METACLASS_CACHE{$_[0]} = $_[1] }
+ sub weaken_metaclass { weaken($METACLASS_CACHE{$_[0]}) }
+ sub does_metaclass_exist { exists $METACLASS_CACHE{$_[0]} && defined $METACLASS_CACHE{$_[0]} }
+ sub remove_metaclass_by_name { $METACLASS_CACHE{$_[0]} = undef }
};
-sub new {
- my $class = shift;
- my %args = @_;
+sub _construct_class_instance {
+ my($class, %args) = @_;
- $args{attributes} = {};
+ $args{attributes} = {};
$args{superclasses} = do {
no strict 'refs';
- \@{ $args{name} . '::ISA' };
+ \@{ $args{package} . '::ISA' };
};
$args{roles} ||= [];
bless \%args, $class;
}
-sub name { $_[0]->{name} }
+sub name { $_[0]->{package} }
sub superclasses {
my $self = shift;
}
}
-sub compute_all_applicable_attributes {
+sub compute_all_applicable_attributes { shift->get_all_attributes(@_) }
+sub get_all_attributes {
my $self = shift;
my (@attr, %seen);
my $clone = bless { %$instance }, ref $instance;
- foreach my $attr ($class->compute_all_applicable_attributes()) {
+ foreach my $attr ($class->get_all_attributes()) {
if ( defined( my $init_arg = $attr->init_arg ) ) {
if (exists $params{$init_arg}) {
$clone->{ $attr->name } = $params{$init_arg};
my $self = shift;
my %args = (
inline_constructor => 1,
+ inline_destructor => 1,
@_,
);
for my $class ($self->linearized_isa) {
next unless $class->can('meta') and $class->meta->can('roles');
- for my $role (@{ $self->roles }) {
+ for my $role (@{ $class->meta->roles }) {
return 1 if $role->name eq $role_name;
}
}
}
sub create {
- my ($self, $package_name, %options) = @_;
+ my ($class, $package_name, %options) = @_;
(ref $options{superclasses} eq 'ARRAY')
|| confess "You must pass an ARRAY ref of superclasses"
version
authority
)};
- my $meta = $self->initialize( $package_name => %initialize_options );
+ my $meta = $class->initialize( $package_name => %initialize_options );
# FIXME totally lame
$meta->add_method('meta' => sub {
- $self->initialize(ref($_[0]) || $_[0]);
+ Mouse::Meta::Class->initialize(ref($_[0]) || $_[0]);
});
$meta->superclasses(@{$options{superclasses}})
Begins keeping track of the existing L<Mouse::Meta::Attribute> for the owner
class.
-=head2 compute_all_applicable_attributes -> (Mouse::Meta::Attribute)
+=head2 get_all_attributes -> (Mouse::Meta::Attribute)
Returns the list of all L<Mouse::Meta::Attribute> instances associated with
this class and its superclasses.
This returns a list of attribute names which are defined in the local
class. If you want a list of all applicable attributes for a class,
-use the C<compute_all_applicable_attributes> method.
+use the C<get_all_attributes> method.
=head2 has_attribute Name -> Bool
=head2 clone_instance Instance, Parameters -> Instance
-Clones the given C<Instance> and sets any additional parameters.
+The clone_instance method has been made private.
+The public version is deprecated.
=cut