view release on metacpan or  search on metacpan

lib/Scalar/Random/PP/OO.pm  view on Meta::CPAN

	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 Scalar::Random::PP::OO::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){
		Scalar::Random::PP::OO::Util::apply_all_roles($package_name, @{$roles});
	}

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

	return $meta;
}

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

	return if $Scalar::Random::PP::OO::Util::in_global_destruction;

	my $serial_id = $self->{anon_serial_id};

	return if !$serial_id;
	# mortal anonymous class

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

	# @ISA is a magical variable, so we 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;
}

sub throw_error{
	my($self, $message, %args) = @_;

	local $Carp::CarpLevel  = $Carp::CarpLevel + 1 + ($args{depth} || 0);
	local $Carp::MaxArgNums = 20; # default is 8, usually we use named args which gets messier though

	if(exists $args{longmess} && !$args{longmess}){ # intentionaly longmess => 0
		Carp::croak($message);
	}
	else{
		Carp::confess($message);
	}
}

# Contents of Mouse::Meta::Role
package Scalar::Random::PP::OO::Meta::Role;
use Scalar::Random::PP::OO::Util qw(:meta not_supported); # enables strict and warnings

use Scalar::Random::PP::OO::Meta::Module;
our @ISA = qw(Scalar::Random::PP::OO::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{