view release on metacpan or  search on metacpan

lib/Mousse.pm  view on Meta::CPAN

		${ $package_name . '::AUTHORITY' } = delete $options{authority} if exists $options{authority};
	}

	my $meta = $self->initialize( $package_name, %options);

	Scalar::Util::weaken($METAS{$package_name})
		if $mortal;

	$meta->add_method(meta => sub {
		$self->initialize(ref($_[0]) || $_[0]);
	});

	$meta->superclasses(@{$superclasses})
		if defined $superclasses;

	# NOTE:
	# process attributes first, so that they can
	# install accessors, but locally defined methods
	# can then overwrite them. It is maybe a little odd, but
	# I think this should be the order of things.
	if (defined $attributes) {
		if(ref($attributes) eq 'ARRAY'){
			# array of Mousse::Meta::Attribute
			foreach my $attr (@{$attributes}) {
				$meta->add_attribute($attr);
			}
		}
		else{
			# hash map of name and attribute spec pairs
			while(my($name, $attr) = each %{$attributes}){
				$meta->add_attribute($name => $attr);
			}
		}
	}
	if (defined $methods) {
		while(my($method_name, $method_body) = each %{$methods}){
			$meta->add_method($method_name, $method_body);
		}
	}
	if (defined $roles and !$options{in_application_to_instance}){
		Mousse::Util::apply_all_roles($package_name, @{$roles});
	}

	if($cache_key){
		$IMMORTALS{$cache_key} = $meta;
	}

	return $meta;
}

sub DESTROY{
	my($self) = @_;

	return if $Mousse::Util::in_global_destruction;

	my $serial_id = $self->{anon_serial_id};
	return if !$serial_id;

	# XXX: cleaning stash with threads causes panic/SEGV on legacy perls.
	if(exists $INC{'threads.pm'}) {
		# (caller)[2] indicates the caller's line number,
		# which is zero when the current thread is joining (destroying).
		return if( (caller)[2] == 0);
	}

	# clean up mortal anonymous class stuff

	# @ISA is a magical variable, so we must clear it manually.
	@{$self->{superclasses}} = () if exists $self->{superclasses};

	# Then, clear the symbol table hash
	%{$self->namespace} = ();

	my $name = $self->name;
	delete $METAS{$name};

	$name =~ s/ $serial_id \z//xms;
	no strict 'refs';
	delete ${$name}{ $serial_id . '::' };
	return;
}


# Contents of Mouse::Meta::Role
package Mousse::Meta::Role;
use Mousse::Util qw(:meta); # enables strict and warnings

use Mousse::Meta::Module;
our @ISA = qw(Mousse::Meta::Module);

sub method_metaclass;

sub _construct_meta {
	my $class = shift;

	my %args  = @_;

	$args{methods}          = {};
	$args{attributes}       = {};
	$args{required_methods} = [];
	$args{roles}            = [];

	my $self = bless \%args, ref($class) || $class;
	if($class ne __PACKAGE__){
		$self->meta->_initialize_object($self, \%args);
	}
	return $self;
}

sub create_anon_role{
	my $self = shift;
	return $self->create(undef, @_);
}

sub is_anon_role;

sub get_roles;

sub calculate_all_roles {
	my $self = shift;
	my %seen;
	return grep { !$seen{ $_->name }++ }
		   ($self, map  { $_->calculate_all_roles } @{ $self->get_roles });