diff 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 diff
--- a/Lib/IMPL/lang.pm	Sat Apr 23 23:12:06 2011 +0400
+++ b/Lib/IMPL/lang.pm	Thu May 12 08:57:19 2011 +0400
@@ -5,11 +5,128 @@
 use parent qw(Exporter);
 use IMPL::_core::version;
 
+require IMPL::Class::PropertyInfo;
 
-our @EXPORT = qw(&is);
+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]) }
+	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];
 }
 
-1;
\ No newline at end of file
+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;