view release on metacpan or  search on metacpan

lib/Frost/Meta/Class.pm  view on Meta::CPAN

package Frost::Meta::Class;

#	LIBS
#
use Moose::Role;

use Frost::Types;
use Frost::Util;

#	CLASS VARS
#
our $VERSION	= 0.63;
our $AUTHORITY	= 'cpan:ERNESTO';

#	CLASS METHODS
#
sub _construct_instance
{
	die "mutable is VERBOTEN";
}

#	PUBLIC ATTRIBUTES
#
has _readonly_attributes	=> ( is => 'ro', isa => 'HashRef',	lazy_build => 1	);
has _transient_attributes	=> ( is => 'ro', isa => 'HashRef',	lazy_build => 1	);
has _derived_attributes		=> ( is => 'ro', isa => 'HashRef',	lazy_build => 1	);
has _virtual_attributes		=> ( is => 'ro', isa => 'HashRef',	lazy_build => 1	);
has _index_attributes		=> ( is => 'ro', isa => 'HashRef',	lazy_build => 1	);
has _unique_attributes		=> ( is => 'ro', isa => 'HashRef',	lazy_build => 1	);
has _auto_id_attributes		=> ( is => 'ro', isa => 'HashRef',	lazy_build => 1	);
has _auto_inc_attributes	=> ( is => 'ro', isa => 'HashRef',	lazy_build => 1	);

#	CONSTRUCTORS
#
sub _build__readonly_attributes	{ $_[0]->_build_features ( 'readonly'	);	}
sub _build__transient_attributes	{ $_[0]->_build_features ( 'transient'	);	}
sub _build__derived_attributes	{ $_[0]->_build_features ( 'derived'	);	}
sub _build__virtual_attributes	{ $_[0]->_build_features ( 'virtual'	);	}
sub _build__index_attributes		{ $_[0]->_build_features ( 'index'		);	}
sub _build__unique_attributes		{ $_[0]->_build_features ( 'unique'		);	}
sub _build__auto_id_attributes	{ $_[0]->_build_features ( 'auto_id'	);	}
sub _build__auto_inc_attributes	{ $_[0]->_build_features ( 'auto_inc'	);	}

#	DESTRUCTORS
#

#	PUBLIC METHODS
#
sub is_readonly	{ $_[0]->_is_feature ( $_[1], 'readonly'	);	}
sub is_transient	{ $_[0]->_is_feature ( $_[1], 'transient'	);	}
sub is_derived		{ $_[0]->_is_feature ( $_[1], 'derived'	);	}
sub is_virtual		{ $_[0]->_is_feature ( $_[1], 'virtual'	);	}
sub is_index		{ $_[0]->_is_feature ( $_[1], 'index'		);	}
sub is_unique		{ $_[0]->_is_feature ( $_[1], 'unique'		);	}
sub is_auto_id		{ $_[0]->_is_feature ( $_[1], 'auto_id'	);	}
sub is_auto_inc	{ $_[0]->_is_feature ( $_[1], 'auto_inc'	);	}

around add_attribute => sub
{
	my $next	= shift;
	my $self	= shift;

	my $attr	= ( blessed $_[0] && $_[0]->isa ( 'Class::MOP::Attribute' ) ? true : false );

	return $self->$next ( @_ )		if $attr;

	my ( $name, @params )	= @_;

	my %options	= ( ( scalar @params == 1 and ref($params[0]) eq 'HASH' ) ? %{$params[0]} : @params );

	##IS_DEBUG and DEBUG __PACKAGE__, '->add_attribute start', Dump [ $name, \%options ], [qw( name options )];

	my $base_name	= $name;

	$base_name	=~ s/^\+//;

	if ( $base_name !~ /^( id )$/x )
	{
		( exists $options{auto_id}		and $options{auto_id} )		and die "Attribute $base_name can not be auto_id";
		( exists $options{auto_inc}	and $options{auto_inc} )	and die "Attribute $base_name can not be auto_inc";
	}

	if ( $base_name =~ /^( id )$/x )
	{
		( exists $options{transient}	and $options{transient}	)	and die "Attribute $base_name can not be transient";
		( exists $options{derived}		and $options{derived}	)	and die "Attribute $base_name can not be derived";
		( exists $options{virtual}		and $options{virtual}	)	and die "Attribute $base_name can not be virtual";
		( exists $options{index}		and $options{index}		)	and die "Attribute $base_name can not be indexed";

		(
			( exists $options{auto_id}		and $options{auto_id} )