view Lib/IMPL/lang.pm @ 167:1f7a6d762394

SQL schema in progress
author sourcer
date Thu, 12 May 2011 08:57:19 +0400
parents 76515373dac0
children 6148f89bb7bf
line wrap: on
line source

package IMPL::lang;
use strict;
use warnings;

use parent qw(Exporter);
use IMPL::_core::version;

require IMPL::Class::PropertyInfo;

our @EXPORT      = qw(&is);
our %EXPORT_TAGS = (
	base => [
		qw(
		  &is
		  )
	],
	constants => [
		qw(
		  &ACCESS_PUBLIC
		  &ACCESS_PROTECTED
		  &ACCESS_PRIVATE
		  &PROP_GET
		  &PROP_SET
		  &PROP_OWNERSET
		  &PROP_LIST
		  &PROP_ALL
		  )
	],

	declare => [
		qw(
		  &public
		  &protected
		  &private
		  &virtual
		  &property
		  &static
		  &property
		  )
	],
	compare => [
		qw(
		  &equals
		  &equals_s
		  )
	]
);

our @EXPORT_OK = keys %{ { map (($_,1) , map (@{$_}, values %EXPORT_TAGS) ) } };

use constant {
	ACCESS_PUBLIC    => 1,
	ACCESS_PROTECTED => 2,
	ACCESS_PRIVATE   => 3,
	PROP_GET         => 1,
	PROP_SET         => 2,
	PROP_OWNERSET    => 10,
	PROP_LIST        => 4,
	PROP_ALL         => 3
};

sub is($$) {
	eval { $_[0]->isa( $_[1] ) };
}

sub virtual($) {
	$_[0]->Virtual(1);
	$_[0];
}

sub public($) {
	$_[0]->Access(ACCESS_PUBLIC);
	$_[0]->Implement;
	$_[0];
}

sub private($) {
	$_[0]->Access(ACCESS_PRIVATE);
	$_[0]->Implement;
	$_[0];
}

sub protected($) {
	$_[0]->Access(ACCESS_PROTECTED);
	$_[0]->Implement;
	$_[0];
}

sub property($$;$) {
	my ( $propName, $mutators, $attributes ) = @_;
	my $Info = new IMPL::Class::PropertyInfo(
		{
			Name       => $propName,
			Mutators   => $mutators,
			Class      => scalar(caller),
			Attributes => $attributes
		}
	);
	return $Info;
}

sub static($$) {
	my ( $name, $value ) = @_;
	my $class = caller;
	$class->static_accessor( $name, $value );
}

sub equals {
	if (defined $_[0]) {
		return 0 if (not defined $_[1]);
		
		return $_[0] == $_[1];
	}  else {
		return 0 if defined $_[1];
		
		return 1;
	}
}

sub equals_s {
	if (defined $_[0]) {
		return 0 if (not defined $_[1]);
		
		return $_[0] eq $_[1];
	}  else {
		return 0 if defined $_[1];
		
		return 1;
	}
}

1;